Amiga Plus 1995 #1/Amiga Plus 1995 #1.iso/fish-disketten/fish_941-950/d949/bbbbs/bbbbs65.lha/rexx/BBBBS.baud

Text File | 1993-10-31 | 204KB | 7,419 lines

/* $VER: BBBBS.baud 6.5 © 1993 Richard Lee Stockton 7:58PM (31.10.93)
       - FREELY DISTRIBUTABLE AS LONG AS THIS NOTICE REMAINS -

       BBBBS.baud. A full-featured BBS in ARexx for Baudbandit
  based on 'Answer.baud'. Thanks to Greg Cunningham for BaudBandit!
   See Information/BBBBS.doc & rexx/bbsLOCAL.rexx for install info
*/

saypath='SYS:Utilities/Say'

copyright.=''
copyright.1=STRIP(SUBSTR(SOURCELINE(1),10))
copyright.2='
from Gramma Software 21305-60th Ave West, Mountlake Terrace WA 98043-2009'
copyright.3='
ARexx portions of this software copyright 1990-93 Richard Lee Stockton'
copyright.4='- FREELY DISTRIBUTABLE as long as this notice remains -'

/* If QuickSortPort not found then try to run setup.rexx */

IF ~SHOW('P','QuickSortPort') THEN CALL setup.rexx()
IF ~SHOW('P','QuickSortPort') THEN EXIT 666
IF SHOW('P','BBBBS') THEN
  DO
    SAY 'BBBBS is already running!'
    EXIT 0
  END

CALL OPENPORT('BBBBS')
CALL SETCLIP('BBS_version',copyright.1)
CALL SETCLIP('BBS_localfiles')
CALL SETCLIP('BBS_localusers')
CALL SETCLIP('BBS_interpret')
CALL SETCLIP('BBS_maint')
CALL SETCLIP('BBS_MESSAGE')
CALL SETCLIP('BBS_BROWSE')
CALL SETCLIP('BBS_MSGS')
CALL SETCLIP('BBS_QUIT')

/* try to trap everything */

OPTIONS RESULTS
OPTIONS FAILAT 999999
NUMERIC DIGITS 14
SIGNAL ON HALT
SIGNAL ON SYNTAX
SIGNAL ON FAILURE
SIGNAL OFF BREAK_C
SIGNAL OFF BREAK_E

PARSE VERSION . . cpu .
cpu=RIGHT(cpu,2)/10
IF cpu<1 THEN cpu=1
Status Vers
BB_VERS=RESULT
bm=50
IF RIGHT(BB_VERS,4)>1.59 THEN bm=25

dcd
IF RC=0 THEN Send 'ATH1\r'

bbsprefs.=0  /* start with all prefs OFF */
alpha.=''
logonflag=1
emailonline=-1
CALL zerovars()


/* User data structure by line */

text.=''
text.1='   Full Name'
text.2='      Street'
text.3='City, ST Zip'
text.4=' Voice Phone'
text.5='    Password'
text.6='    Protocol'
text.7='LinesPerPage'
text.8=' Preferences'
text.9='    Computer'
text.10='   Interests'
text.11='Session Time'
text.12='FirstSession'
text.13='Last Session'
text.14='      UpLoad'
text.15='    Download'
text.16='   Last File'
text.17='Ratio  Email'
text.18='    Winnings'
text.19='       Usage'
text.20='       Level'
text.21='Exclude DIRS'
text.22='   Msgs Read'
text.23='   Msgs Writ'
text.24=' Marked Msgs'
text.25='Marked Files'
text.26='QUICKexclude'
text.27=' CBV numbers'


name=''
CR='0D'x
LF='0A'x

SAY CR
SAY CENTER(copyright.1,75)||CR

CALL PRAGMA('W','N')
CALL config()
IF bbsprefs.15~=0 THEN
  CALL send2log('===== BBBBS started' DATE('W') DATE() TIME('C') '=====')

IF ~EXISTS(bbspath'Numbers/FirstLogon') THEN
  ADDRESS COMMAND 'C:Date >'bbspath'Numbers/FirstLogon'

SAY CENTER(copyright.2,75)||CR

/* open printer? */
IF bbsprefs.3 THEN
  DO
    IF ~OPEN(p,'PRT:','W') THEN
      DO
        CALL send2log('failed to open printer.')
        bbsprefs.3=0
      END
  END

/* CALL PRAGMA('W','W')   <-- UN-COMMENT THIS LINE TO ENABLE REQUESTERS */
CALL colors(1)
Capture OFF
Timeout 120
SAY CENTER(copyright.3,75)||CR

excuses.=''
courtesy=''
courtesyflag=0
SAY CENTER(copyright.4,75)||CR
SAY CR
SAY CR
SAY '                      Setting up, please wait...'CR
SAY CR

msg.=''
IF readopen(bbspath'Lists/Conferences') THEN
  DO
    DO i=1
      line=READLN(f)
      IF line='END' THEN BREAK
      IF EOF(f) THEN BREAK
      num=WORD(line,1)
      IF DATATYPE(num,'W') THEN msg.num=WORD(line,2)
    END
    CALL CLOSE(f)
  END

dirs.=''
IF readopen(bbspath'Lists/Libraries') THEN
  DO
    DO i=1
      line=READLN(f)
      IF line='END' | EOF(f) THEN LEAVE i
      num=WORD(line,1)
      IF DATATYPE(num,'W') THEN dirs.num=STRIP(WORD(line,2))
    END
    CALL CLOSE(f)
  END
CALL loaduserlist()
SAY CR
SAY '          The larger the BBS gets, the longer it takes to setup...'CR
CALL loadfiles()
dcd
IF RC~=0 THEN
  DO
    SAY CR
    SAY '      If it seems to take forever, ask the sysop to try' pen3'Resident'def 'mode.'CR
  END
SAY CR
CALL set_grand()
CALL loadalpha()

dcd
IF RC=0 THEN
  DO
    logonflag=0
    SIGNAL DONE
  END

LOGON:
CALL checkdcd()
bps=0
SetMark 'CONNECT'
IF RC=1 THEN
  DO
    GetLine
    connectline=RESULT
    PARSE VAR connectline 'CONNECT'bps
    CALL STRIP(bps)
    DO i=3 WHILE DATATYPE(SUBSTR(bps,i,1),'N')
    END
    bps=LEFT(bps,i-1)
  END
IF bps<300 | bps>38400 THEN
  DO
    SetMark 'CARRIER'
    IF RC=1 THEN
      DO
        GetLine
        connectline=RESULT
        PARSE VAR connectline 'CARRIER'bps
        CALL STRIP(bps)
      END
    ELSE bps='000 '
  END
DO i=3 WHILE DATATYPE(SUBSTR(bps,i,1),'N')
END
bps=LEFT(bps,i-1)
SIGNAL ON BREAK_C
SIGNAL OFF BREAK_E
REMOTE ON
TimeOut 120
IF bps<300 THEN bps=getbaudrate()
IF bps>16800 THEN bps=getinput(1 0 'Please enter your modem to modem baudrate > ')
IF bps<300 THEN SIGNAL DONE
bps=bps%1
IF logonflag=0 THEN
  DO
    logonflag=1
    DO i=1 TO 7
      SAY '  'CR
    END
    DO i=1 TO 4
      SAY CENTER(copyright.i,75)||CR
    END
    CALL sound('LOGON')
    CALL DELAY(150)
    CALL colors(1)
    SAY CR
    SAY CR
    SAY CR
  END

IF alpha.0='' THEN CALL loadalpha()

CALL TIME('R')

/** Identify (title) message */
IF EXISTS(bbspath'BBS_TEXT/HELLO') THEN
  DO
    nonstop=1
    arg=bbspath'BBS_TEXT/HELLO'
    CALL readlines(arg 1)
    CALL seelines(0)
    nonstop=0
  END
SAY CR

SAY 'Running on' BB_VERS 'at' bps 'baud. ' TIME('C') DATE('W') DATE()||CR
Stat 'Z'
CALL checkdcd()

/* Ask for name */
name=''
courtesy=''
Queue CR
DO count=1 TO 3
  name=getinput(1 0 'Please enter name: ')
  name=cleanstring(1':'name)
  IF name='NEW' THEN LEAVE count
  IF name~='' THEN
    DO
      IF FIND(userlist,name)>0 THEN LEAVE count
      IF FIND(exclusion,name)>0 THEN
        DO
          SAY 'Sorry, that is a reserved name.'CR
          name=''
          ITERATE count
        END
      CALL loadcourtesy()
      IF bbsprefs.7>0 | FIND(courtesy,name)>0 THEN
        DO
          SAY CR
          SAY 'Welcome' name'!'CR
          SAY 'You will be automatically validated after you enter your user info.'CR
          SAY CR
          LEAVE count
        END
    END
  IF count<3 THEN
    DO
      IF STRIP(name)~='' THEN SAY name 'not found.  Please try again.'CR
      SAY 'New Users enter NEW to apply for validation.'CR
    END
END
IF count>3 THEN SIGNAL DONE
CALL TIME('R')
logontime=TIME('C')
line=left(name,16,' ') 'logged in  at' time('C') date('W') date() 'at' bps 'baud'
CALL send2log(line)
CALL checkUser()
IF UPPER(WORD(data.12,3))~='BIRTHDAY:' THEN
  DO
    SAY CR
    SAY 'Please help us out by entering the following information.'CR
    CALL getbirth()
    SAY '   Thank you!'CR
  END
prevcaller=''
prevcaller=GETCLIP('BBS_lastcaller')
IF prevcaller~='' THEN CALL SETCLIP('BBS_prevcaller',prevcaller)
city=docity(data.3)
CALL SETCLIP('BBS_lastcaller',name city'  'TIME('C') DATE())
CALL SETCLIP('BBS_level',level)
CALL postuser(0)
Timeout maxidle         /* max idle time at prompts */

IF RIGHT(WORD(data.12,4),4)=RIGHT(DATE('S'),4) THEN
  DO
    arg=bbspath'BBS_TEXT/BIRTHDAY'
    IF EXISTS(arg) THEN
      DO
        SAY CR
        CALL showtext(arg)
      END
    SAY CR
    SAY '***  Happy Birthday,' pen3||data.1||def', and many more!  ***'CR
    SAY CR
  END
SAY CR

/* Get current protocol */
Status Trans
protocol=STRIP(RESULT)

IF bbsLOGON.baud(name level)=1 THEN SIGNAL OUT
CALL checkdcd()
CALL sortlibraries()
IF FIND(data.8,'QUICK')>0 THEN
  DO
    logonflag=0
    CALL do_quick(0)
    logonflag=1
  END

/*
Opening Display after logon. Seen by all Users ONCE A DAY. It first
looks for a unique yearly data (ie, WELCOME.0704), then daily data
(ie, WELCOME.Fri), and finally a simple, everyday 'WELCOME' datafile
*/

IF DATE('I')>lastondate THEN
  DO
    SAY CR
    arg=bbspath'BBS_TEXT/WELCOME.'RIGHT(DATE('S'),4)
    IF EXISTS(arg) THEN CALL showtext(arg)
    SAY CR
    arg=bbspath'BBS_TEXT/WELCOME.'LEFT(DATE('W'),3)
    IF EXISTS(arg) THEN CALL showtext(arg)
    SAY CR
    arg=bbspath'BBS_TEXT/WELCOME'
    IF EXISTS(arg) THEN CALL showtext(arg)

/*
Looks for format UNTIL.YYYYMMDD ie, "UNTIL.19920514"
Deletes any that are previous to "today"
*/

    untils.=''
    IF FileList(bbspath'BBS_TEXT/UNTIL.*',untils)>0 THEN
      DO
        CALL QSORT(1,untils.0,untils)
        DO ui=1 TO untils.0
          IF RIGHT(untils.ui,8)<DATE('S') THEN CALL DELETE(untils.ui)
          ELSE
            DO
              SAY CR
              CALL showtext(untils.ui)
            END
        END
      END
    DROP untils.
  END

IF bbsprefs.1 & ~terseflag THEN
  DO
    IF doGrin()>3 THEN CALL waiting()
    IF EXISTS(bbspath'rexxDoors/Moon.rexx') THEN CALL Moon.rexx()
    IF EXISTS(bbspath'rexxDoors/Time.rexx') THEN CALL Time.rexx()
    IF FIND(UPPER(SHOWLIST('A')),'TODAY')>0 THEN
      DO
        IF EXISTS('RAM:TODAY') THEN
          DO
            finfo=STATEF('RAM:TODAY')
            IF WORD(finfo,5)~=DATE('I') THEN
              ADDRESS COMMAND 'C:Today091 >RAM:TODAY'
          END
        ELSE ADDRESS COMMAND 'C:Today091 >RAM:TODAY'
        IF EXISTS('RAM:TODAY') THEN
          DO
            CALL readlines('RAM:TODAY' 1)
            CALL seelines(0)
          END
      END
    SAY CR
  END

CALL readmail(0)
IF ~terseflag THEN
  DO
    IF level>sysoplevel THEN
      DO
        lstmail=WORD(data.17,3)
        IF ~DATATYPE(lstmail,'W') THEN lstmail=0
        IF countcheck(bbspath'Numbers/LastMail' 0)>lstmail THEN
          IF getinput(1 1 'Check Email? (Ny) > ')='Y' THEN CALL mailreport()
        IF level<99 THEN
          DO
            SAY CR
            CALL showtext(bbspath'Email/'sysop'/NEW_FILES')
          END
        SAY CR
        CALL showtext(bbspath'Lists/NEW_USERS')
        CALL showtext(bbspath'Lists/CBV_USERS')
      END
    CALL logonstats()
    CALL newinfo()
  END
CALL showmarked(1)
CALL setdir(libpath||dirs.1)
logonflag=0


/***** MAIN *****/

IF menu~='ALL' THEN menu='MAIN'

RESTART:
IF name='' | data.20='' | logonflag THEN SIGNAL LOGON  /* login was interrupted */
SIGNAL ON BREAK_C
SIGNAL ON BREAK_E

waitchar=''
string=''
opt=''
IF level<1 THEN menu='NEW'
DO WHILE(opt~='G')
  go=0
  DO WHILE(~go)
    IF waitchar='' | waitchar='?' THEN
      DO
        commands='cghiqrsvwxyz!#,'
        IF level>0  THEN commands='abcdefghijlmnoprstuvwxyz!$#&+,.'
        IF level>sysoplevel THEN commands=commands'k%^()=;'
        IF level=99 THEN commands=commands'@~'
        commands=commands'?'
        IF menuflag | waitchar='?' | string='?' THEN CALL menus()
        ELSE SAY pen3'COMMANDS:'def commands||CR
        opt='MENU'
        arg=''
        CALL postuser(1)
      END
    CALL showtime()
    line=''
    line=line||bak2' 'TIME('C')' 'def
    IF menu='ALL' | menu='FILE' THEN
      line=line pen3'FILE_LIBRARY:'plaindir||def
    ELSE IF menu='MSG' THEN line=line pen3'MESSAGES:'def
    ELSE line=line pen3'MAIN:'def
    line=line'  'bbsname
    IF waitchar='' THEN waitchar=getinput(0 0 line' > ')
    PARSE VAR waitchar string' 'arg
    CALL checkdcd()
    nonstop=0
    string=UPPER(STRIP(string))
    IF POS('+++',string)>0 THEN SIGNAL OUT
    IF string='OFF' | string='BYE' THEN SIGNAL LOGOUT2
    IF string='FL' & level>0 THEN CALL Friends()
    CALL checkalias()
    waitchar=''
    warnings=0
    IF DATATYPE(string,'W') THEN
      DO
        IF string>level THEN
          DO
            arg=STRIP(string arg)
            string='D'
          END
        ELSE
          DO
            dirnum=string
            CALL chdir2()
            CALL since()
          END
      END
    IF string='QUICK' & level>0 THEN CALL do_quick(1)
    opt=left(string,1)
    IF opt='G' THEN
      DO
        IF getinput(1 1 pen3'Logoff? (nY) > 'def)='N' THEN opt='?'
      END
    go=1    /* check for access */
    IF POS(opt,UPPER(commands))=0 THEN go=0
  END
  IF CBVflag=1 THEN SIGNAL OUT
  CALL postuser(1)
  OPTIONS PROMPT 'Filename: '
  SELECT
    WHEN opt='A' THEN CALL showalpha()
    WHEN opt='B' THEN CALL browse()
    WHEN opt='C' THEN CALL editor('MAIL' sysop)
    WHEN opt='D' THEN CALL dload()
    WHEN opt='E' THEN CALL readmail(1)
    WHEN opt='F' THEN CALL do_F()
    WHEN opt='H' THEN CALL help('MAIN')
    WHEN opt='I' THEN CALL information()
    WHEN opt='J' THEN CALL jump2rexx()
    WHEN opt='K' THEN CALL killuser()
    WHEN opt='L' THEN CALL list()
    WHEN opt='M' THEN IF menu~='ALL' THEN menu='MSG'
    WHEN opt='N' THEN CALL newfiles()
    WHEN opt='O' THEN CALL otheruser()
    WHEN opt='P' THEN CALL editor('MSG')
    WHEN opt='R' THEN IF menu='NEW' THEN CALL CBV();ELSE CALL readmessages()
    WHEN opt='S' THEN CALL bbsSEARCH()
    WHEN opt='T' THEN CALL chpro()
    WHEN opt='U' THEN CALL uload(1)
    WHEN opt='V' THEN CALL showtext(bbspath'Usage/USER.LOG')
    WHEN opt='W' THEN CALL showuserlist()
    WHEN opt='X' THEN CALL switchmenuflag()
    WHEN opt='Y' THEN CALL edituser()
    WHEN opt='Z' THEN CALL counts()
    WHEN opt='~' THEN CALL sysED(1)
    WHEN opt='!' THEN CALL yell()
    WHEN opt='@' THEN CALL shell()
    WHEN opt='#' THEN CALL switchcolors()
    WHEN opt='$' THEN IF menu='ALL' THEN menu='MAIN'; ELSE menu='ALL'
    WHEN opt='%' THEN CALL editnote()
    WHEN opt='^' THEN CALL readlogs()
    WHEN opt='&' THEN CALL profiles(1)
    WHEN opt='+' THEN CALL ext_dload()
    WHEN opt='(' THEN CALL filereport()
    WHEN opt=')' THEN CALL mailreport()
    WHEN opt='=' THEN CALL levelreport()
    WHEN opt=';' THEN CALL changename()
    WHEN opt=',' THEN DO;CALL hourly();CALL waiting();END
    WHEN opt='.' THEN IF menu~='ALL' THEN menu='MAIN'
    WHEN opt='?' THEN IF menuflag THEN CALL help('MAIN')
    OTHERWISE NOP
  END
END
SIGNAL LOGOUT
EXIT



/* FUNCTIONS */


do_F:
IF menu='FILE' | menu='ALL' THEN
  DO
    IF STORAGE()<(bbsprefs.15+100000) | GETCLIP('BBS_libs.0')~='' THEN
      DO
        SAY CR
        SAY 'Sorry! Not enough memory left for background archiving.'CR
        SAY 'Please try again in 10 minutes or so.'CR
        SAY CR
        RETURN
      END
    DO i=0 TO libs.0
      CALL SETCLIP('BBS_libs.'i,libs.i)
    END
    IF Make_BrowseList.baud(name colorflag files.0)=0 THEN
      DO
        CALL send2log('Arc: Make_BrowseList.baud')
        IF emailonline>=0 THEN emailonline=emailonline+1
      END
    DO i=0 TO libs.0
      CALL SETCLIP('BBS_libs.'i)
    END
  END
ELSE IF menu~='ALL' THEN menu='FILE'
RETURN


cleanstring:
PARSE ARG nflag':'cstr
bot=TRIM(XRANGE(,' '))
bot=COMPRESS(bot,'1B'x)  /* ESC for ANSI */
top=XRANGE('7F'x)
IF nflag=1 THEN
  DO
    bot=bot||XRANGE('!','@')'[\]`~{:}'
    cstr=TRANSLATE(UPPER(cstr),' ','_')
  END
cstr=COMPRESS(cstr,bot||top)
IF nflag~=2 THEN cstr=STRIP(cstr)
IF nflag=1 THEN cstr=SPACE(cstr,1,'_')
RETURN cstr


showtext:
PARSE ARG arg .
IF EXISTS(arg) THEN
  DO
    CALL readlines(arg 1)
    CALL seelines(1)
    nonstop=0
    CALL waiting()
  END
RETURN


doGrin:
IF ~EXISTS(bbspath'rexxDoors/Grin_du_Jour.rexx') THEN RETURN 0
CALL setdir(bbspath'rexxDoors')
temp=Grin_du_Jour.rexx()
SAY CR
RETURN temp


send2log:
PARSE ARG sendline
logfile=bbspath'Logs/log.'DATE('S')    /* daily logs */
IF ~OPEN('log',logfile,'A') THEN
  DO
    IF ~OPEN('log',logfile,'W') THEN
      DO
        SAY 'failed to open log file'
        SIGNAL DONE
     END
  END
CALL WRITELN('log',sendline)
CALL CLOSE('log')
IF bbsprefs.3=1 THEN CALL WRITELN(p,sendline)
RETURN


send2last:
PARSE ARG sendline
IF bbsprefs.24~=1 & name=sysop THEN RETURN
lynes.=''
lynes.0=2
lynes.1='        -'pen3 bbsname def'user log for the last 99 calls -'
lynes.2=sendline
logfile=bbspath'USAGE/USER.LOG'  /* simple usage log */
IF EXISTS(logfile) THEN
  DO
    x=OPEN(lu,logfile,'R')
    IF x=0 THEN RETURN
    CALL READLN(lu)
    DO i=3 TO 99
      sendline=READLN(lu)
      IF EOF(lu) THEN LEAVE i
      lynes.i=sendline
    END
    CALL CLOSE(lu)
    IF i>99 THEN lynes.0=99
    ELSE lynes.0=i-1
  END
x=OPEN(lu,logfile,'W')
IF x=0 THEN RETURN
DO i=1 TO lynes.0
  CALL WRITELN(lu,lynes.i)
END
CALL CLOSE(lu)
RETURN


do_quick:
ARG flag .
IF FIND(UPPER(data.8),'QUICK')=0 THEN
  DO
    SAY CR
    SAY 'The QUICK option is OFF in your current settings.'CR
    SAY CR
    SAY 'Setting the QUICK option to ON will allow you to tell the BBS to'CR
    SAY 'make a .lha archive of all new bbs activity since your last call.'CR
    SAY CR
    SAY 'This archive can then be read (and replied to, and files can be'CR
    SAY 'uploaded and downloaded) using 'pen3'bbsQUICK.rexx'def', the offline read/reply'CR
    SAY 'module for BBBBS, which is available here in the file libraries.'CR
    SAY CR
    IF getinput(1 1 'Turn the QUICK option ON? (Ny) >')~='Y' THEN RETURN
    data.8=data.8 'QUICK'
    CALL saveData(0)
  END
ELSE IF flag=1 THEN
  DO
    IF getinput(1 1 'Turn the QUICK option OFF? (Ny) > ')='Y' THEN
      DO
        temp=data.8
        data.8=''
        DO i=1 TO WORDS(temp)
          IF WORD(temp,i)~='QUICK' THEN data.8=STRIP(data.8 WORD(temp,i))
        END
        ADDRESS COMMAND 'c:delete' bbspath'EmailFiles/'name'/QUICK_#?'
        RETURN
      END
  END
IF getinput(1 1 'Edit your QUICK exclude list? (Ny) > ')='Y' THEN
  DO
    SAY CR
    SAY 'You may EXCLUDE any of these from your QUICK archives.'CR
    SAY pen3||LEFT('-',74,'-')||def||CR
    temp=LEFT(' ',7)
    SAY temp'HELLO          - Pre-logon message.'CR
    SAY temp'WELCOME        - Post-logon message.'CR
    SAY temp'GOODBYE        - Logoff message.'CR
    SAY temp'HOURLY         - Average-Minutes-Per-Hour usage graph.'CR
    SAY temp'STATS.BBS      - Most of the Z command from the main menu.'CR
    SAY temp'filename       - ANY filename in the Information area.'CR
    SAY temp'MESSAGES       - New conference messages.'CR
    SAY temp'FILELIST       - New file descriptions.'CR
    SAY pen3||LEFT('-',74,'-')||def||CR
    SAY 'Enter a space separated list of what you wish to exclude.'CR
    SAY pen3'Exclude:'def data.26||CR
    temp=getinput(1 0 pen3'Exclude: 'def)
    IF temp='' & data.26~='' THEN
      DO
        IF getinput(1 1 'Clear the QUICK exclude list? (nY) > ')~='N' THEN
          data.26=''
      END
    ELSE data.26=temp
    temp='Your QUICK archives will exclude'pen3
    IF data.26='' THEN temp=temp 'nothing!'
    ELSE temp=temp data.26
    SAY temp||def||CR
    CALL saveData(0)
    SAY CR
  END
IF GETCLIP('BBS_'name)~='' THEN
  DO
    SAY CR
    SAY 'The QUICK routines are still working on your archive...'CR
    SAY 'Please try again later.'CR
    SAY CR
    RETURN
  END
quickdir=bbspath'EmailFiles/'name
CALL MAKEDIR(quickdir)
CALL setdir(quickdir)
IF getinput(1 1 'Do you have a QUICKIN file to upload? (Ny) > ')='Y' THEN
  DO
    arg='QUICKIN.lha'
    ul=2
    DO WHILE ul=2
      ul=uload(0)
    END
  END
IF EXISTS(bbspath'EmailFiles/'name'/QUICKIN.lha') & level>=sysoplevel THEN
  IF getinput(1 1 'Process your QUICKIN archive [N]ow or at [L]ogoff? (Ln) > ')='N' THEN
    DO
      ADDRESS AREXX bbsQUICKIN.rexx name level sysoplevel bbsprefs.6
      SAY CR
      SAY 'Processing QUICKIN archive...'CR
      SAY CR
    END
IF GETCLIP('BBS_'name)='QUICK' THEN
  DO
    SAY CR
    SAY 'The QUICK routines are still working on your file(s)...'CR
    SAY CR
    RETURN
  END
arg='RAM:dirlist'
ADDRESS COMMAND 'C:list >'arg quickdir'/QUICK_#? DATES'
IF WORD(STATEF(arg),2)>80 THEN
  DO
    CALL readlines(arg 1)
    CALL seelines(0)
    SAY CR
  END
efiles=UPPER(SHOWDIR(quickdir))
DO qi=1 TO WORDS(efiles)
  qarg=WORD(efiles,qi)
  IF LEFT(qarg,6)='QUICK_' & RIGHT(qarg,4)='.LHA' THEN
    DO
      SAY qarg 'is' WORD(STATEF(qarg),2) 'bytes.'CR
      allargs=qarg
      DO WHILE dload2()=1
      END
      t=''
      DO WHILE t~='N' & t~='Y'
        t=getinput(1 1 'Delete' qarg'? (ny) > ')
      END
      IF t='Y' THEN
        DO
          IF DELETE(quickdir'/'qarg)=1 THEN SAY qarg 'deleted.'CR
          CALL DELETE(quickdir'/'qarg'.xdl')
          qarg=COMPRESS(UPPER(qarg),'QUICK_.LHA')
          CALL DELETE(bbspath'Email/'name'/BBBBS.'qarg)
        END
    END
END
arg=''
SAY CR
IF GETCLIP('BBS_'name)~='' THEN RETURN
IF getinput(1 1 'Archive new BBS activity now? (Ny) > ')='Y' THEN
  DO
    CALL SETCLIP('BBS_city',city)
    CALL SETCLIP('BBS_'name'_26',data.26)
    IF FIND(UPPER(data.26),'STATS.BBS')=0 THEN
      CALL SETCLIP('BBS_statsarg',emailonline grand grand2 files.0)
    IF FIND(UPPER(data.26),'MESSAGES')=0 THEN
      CALL SETCLIP('BBS_'name'_22',data.22)
    CALL MAKEDIR(bbspath'EmailFiles/'name)
    CALL showmarked(0)
    ADDRESS AREXX bbsQUICKOUT.rexx name level lastbrowse WORD(data.16,2) data.21
    CALL send2log('Started QUICKOUT at' TIME('C'))
    SAY CR
    IF FIND(UPPER(data.26),'MESSAGES')=0 THEN
      DO
        clear_marked=1
        DO i=1 TO level
          IF WORD(data.22,i)~=-1 THEN
            lastread.i=countcheck(bbspath'Numbers/LastMessage'i 0)
        END
        SAY CR
      END
    IF FIND(UPPER(data.26),'FILELIST')=0 THEN
      lastbrowse=countcheck(bbspath'Numbers/LastFile' 0)
    newfilesdate=DATE('S') TIME()
    IF writeopen(bbspath'EmailFiles/'name'/Libraries') THEN
      DO
        DO i=1 TO libs.0
          CALL WRITELN(f,libs.i)
        END
        CALL CLOSE(f)
      END
    IF writeopen(bbspath'EmailFiles/'name'/Conferences') THEN
      DO
        DO i=1 TO msgs.0
          CALL WRITELN(f,msgs.i)
        END
        CALL CLOSE(f)
      END
    SAY CR
    IF getinput(1 1 'Logoff Now? (nY) > ')~='N' THEN
      DO
        SAY 'Your archive will be waiting next time you call...'CR
        SAY CR
        SIGNAL LOGOUT2
      END
    SAY CR
    SAY 'Note: You now have no ''new'' files or messages (they are being archived).'CR
    SAY CR
    SAY 'You will be signaled if you are still online when your archive is ready...'CR
    SAY CR
    CALL saveData(1)
    CALL waiting()
  END
ELSE
  DO
    SAY CR
    IF getinput(1 1 'Logoff Now? (nY) > ')~='N' THEN SIGNAL LOGOUT2
  END
SAY CR
CALL setdir(libpath||dirs.1)
RETURN


killuser:
IF level<=sysoplevel THEN RETURN
killcount=0
DO loop=1
  IF arg='' THEN
    DO
      OPTIONS PROMPT 'RETURN=QUIT  Username to Kill: '
      PULL arg
    END
  IF STRIP(arg)='' THEN LEAVE loop
  arg=UPPER(arg)
  arg=SPACE(STRIP(arg),1,'_')
  IF getinput(1 1 'Really kill' arg'? (nY) > ')='N' THEN
    DO
      arg=''
      ITERATE loop
    END
  SAY 'Working...'lineup||CR
  IF readlines(bbspath'Users/'arg 1) THEN
    DO
      SAY 'User' arg 'not found.'CR
      arg=''
      ITERATE loop
    END
  IF level<=lynes.20 THEN
    DO
      SAY '*** Tsk! Tsk!  Your level is not greater than' arg'.'CR
      CALL send2log('Tried to kill:' arg)
      arg=''
      ITERATE loop
    END
  CALL DELETE(bbspath'Users/'arg)
  IF EXISTS(bbspath'Email/'arg) THEN
    DO
      temp=WORDS(SHOWDIR(bbspath'Email/'arg))
      emailonline=emailonline-temp
      ADDRESS COMMAND 'C:DELETE >*' bbspath'Email/'arg 'ALL'
    END
  IF EXISTS(bbspath'EmailFiles/'arg) THEN
    ADDRESS COMMAND 'C:DELETE >*' bbspath'EmailFiles/'arg 'ALL'
  CALL send2log('Killed:' arg)
  SAY CR'User file, Email & EmailFiles for' arg 'have been deleted.'CR
  killcount=killcount+1
  arg=''
END
IF killcount=0 THEN RETURN
CALL DELETE(bbspath'Lists/USERS')
sortuserflag=1
RETURN


menus:
CALL checkdcd()
SAY CR
IF menu='NEW' THEN
  DO
    SAY pen6'     _________________'def||CR
    SAY pen6'  __/  'pen3'New User Menu'pen6'  \___'def||CR
    SAY pen6' |                        |'def||CR
    SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'I'def']nformation        'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'Y'def']our user data     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'W'def']ho is here        'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'S'def']earch user list   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'V'def']iew user log      'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'Z'def'] bbs statistics   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3','def'] hourly stats     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'X'def'] toggle menus     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'#'def'] toggle color     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'!'def'] YELL for SYSOP   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'C'def']omment to SYSOP   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'G'def']oodbye (hangup)   'pen6'|'def||CR
    SAY pen6' |________________________|'def||CR
 IF bbsprefs.22~=0 THEN
   DO
    SAY CR
    SAY 'Local Callers may register and receive' pen7'INSTANT VALIDATION'def'!'CR
    SAY 'Enter R to ['pen3'R'def']egister using Call Back Verify.'CR
   END
  END
ELSE IF menu='MSG' THEN
  DO
    SAY pen6'       ____________'def||CR
    SAY pen6'  ____/  'pen3'Messages'pen6'  \_____'def||CR
    SAY pen6' |                       |'def||CR
    SAY pen6' |'def'   ['pen3'H'def']elp              'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'P'def']ost messages     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'R'def']ead messages     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'S'def']earch messages   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'E'def']mail (private)   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'C'def']omment to SYSOP  'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'QUICK'def'] options     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'FL'def'] Friends List   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'!'def'] YELL for SYSOP  'pen6'|'def||CR
IF(level>sysoplevel) THEN DO
    SAY pen6' |'def'   ['pen3'^'def'] view BBS logs   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3')'def'] email report    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'='def'] level report    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3';'def'] change username 'pen6'|'def||CR;END
IF(level=99) THEN DO
    SAY pen6' |'def'   ['pen3'~'def'] online editor   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'@'def'] dos shell       'pen6'|'def||CR;END
    SAY pen6' |'def'   ['pen3'F'def']iles menu        'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'.'def'] main menu       'pen6'|'def||CR
    SAY pen6' |_______________________|'def||CR
  END
ELSE IF menu='FILE' THEN
  DO
    SAY pen6'         _________'def||CR
    SAY pen6'  ______/  'pen3'Files'pen6'  \_______'def||CR
    SAY pen6' |                        |'def||CR
    SAY pen6' |'def'   ['pen3'A'def']lphabetic list    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'B'def']rowse filenotes   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'N'def']ew files list     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'L'def']ist by Library    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'F'def']ilelist archives  'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'S'def']earch files       'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'U'def']pload             'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'D'def']ownload           'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'T'def']ransfer protocol  'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'+'def'] Extra Devices    'pen6'|'def||CR
IF(level>sysoplevel) THEN DO
    SAY pen6' |'def'   ['pen3'K'def']ill a user        'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'%'def'] edit filenote    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'('def'] file report      'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3';'def'] change username  'pen6'|'def||CR;END
IF(level=99) THEN DO
    SAY pen6' |'def'   ['pen3'@'def'] dos shell        'pen6'|'def||CR;END
    SAY pen6' |'def'   ['pen3'M'def']essages menu      'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'.'def'] main menu        'pen6'|'def||CR
    SAY pen6' |________________________|'def||CR
  END
ELSE IF menu='MAIN' THEN
  DO
    SAY pen6'       _____________'def||CR
    SAY pen6'  ____/  'pen3'Main Menu'pen6'  \_____'def||CR
    SAY pen6' |                        |'def||CR
    SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'I'def']nfomation         'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'J'def']ump to doorways   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'Y'def']our user data     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'W'def']ho is here list   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'S'def']earch userlist    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'O'def']ther users info   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'V'def']iew user log      'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'X'def']pert (no menus)   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'#'def'] toggle colors    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'$'def'] toggle menu(s)   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'&'def'] user profiles    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'Z'def'] bbs statistics   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3','def'] hourly stats     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'G'def']oodbye (hangup)   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'F'def']iles menu         'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'M'def']essages menu      'pen6'|'def||CR
    SAY pen6' |________________________|'def||CR
  END
ELSE IF menu='ALL' THEN
  DO
    SAY pen6'     __________________________________________________________'def||CR
    SAY pen6'  __/   'pen3'Main Menu            File Menu          Message Menu 'pen6'  \__'def||CR
    SAY pen6' |                                                                |'def||CR
    SAY pen6' |'def' ['pen3'H'def']elp               ['pen3'A'def']lphabetical list  ['pen3'P'def']ost messages      'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'I'def']nformation        ['pen3'B'def']rowse filenotes   ['pen3'R'def']ead messages      'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'Z'def'] bbs statiZtics   ['pen3'L'def']ist by Library    ['pen3'E'def']mail (private)    'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'Y'def']our user data     ['pen3'N'def']ew files          ['pen3'C'def']omment to SYSOP   'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'O'def']ther users info   ['pen3'F'def']ilelist archiver  ['pen3'!'def'] YELL for SYSOP   'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'J'def']ump to doorways   ['pen3'+'def'] Extra Devices    ['pen3'X'def']pert (no menus)   'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'S'def']earch menu        ['pen3'D'def']ownload           ['pen3'$'def'] toggle menu(s)   'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'&'def'] user profiles    ['pen3'U'def']pload             ['pen3'#'def'] toggle colors    'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'V'def']iew user log      ['pen3'T'def']ransfer protocol  ['pen3','def'] hourly stats     'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'G'def']oodbye (logoff)   ['pen3'QUICK'def'] options      ['pen3'FL'def'] Friends List    'pen6'|'def||CR
IF(level>sysoplevel) THEN DO
    SAY pen6' |'def' ['pen3'K'def']ill a user        ['pen3'%'def'] edit filenote    ['pen3'='def'] level report     'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'^'def'] view BBS logs    ['pen3'('def'] file report      ['pen3';'def'] change username  'pen6'|'def||CR;END
IF(level=99) THEN
    SAY pen6' |'def' ['pen3'~'def'] online editor    ['pen3'@'def'] dos shell        ['pen3')'def'] email report     'pen6'|'def||CR
    SAY pen6' |________________________________________________________________|'def||CR
  END
QUEUE CR  /* clears any un-CRed input in the queue */
RETURN


help:
ARG helppath .
SAY CR
SAY 'For more detailed help, use ['pen3'I'def']nformation commmand to read BBBBS.COMMANDS.'CR
IF helppath='MAIN' THEN
  SAY 'Commands available from the' pen3||menu||def 'menu:'CR
frontend=bbspath'BBS_HELP/'helppath
backend='.USER'
IF level=0 THEN backend='.NEW'
ELSE IF level=99 THEN backend='.SUPER'
ELSE IF level>sysoplevel THEN backend='.SYSOP'
CALL showtext(frontend||backend)
RETURN


waiting:
CALL checktime()
IF waitchar='Q' THEN
  DO
    waitchar=''
    RETURN
  END
waitchar=''
IF nonstop=1 THEN RETURN
OPTIONS PROMPT pen3'                          RETURN=Continue 'def
PULL waitchar
CALL cleanline(1)
CALL checkdcd()
RETURN


waiting2:
CALL checktime()
IF nonstop=1 THEN RETURN 0
waitchar=getinput(1 1 pen3'   Q=Quit   N=Non-Stop   RETURN=Continue  'def)
IF waitchar='N' THEN
  DO
    nonstop=1
    SAY lineup||pen3'To EXIT non-stop scrolling of text, press CTRL-E        'def||CR
    SAY CR
    CALL DELAY(100)
    waitchar=''
  END
CALL cleanline(1)
CALL checkdcd()
IF waitchar='Q' THEN RETURN 1
RETURN 0


busywait:
ARG bii bi bt
IF bbsprefs.21=0 THEN RETURN
IF bi<1 THEN
  DO
    CALL WRITECH(STDOUT,'080808'x)
    RETURN
  END
IF bi=1 THEN CALL WRITECH(STDOUT,'   ')
IF bi//(bii%2)~=0 THEN RETURN
b=bi//bii
IF b=0 | b=bii%2 THEN
  DO
    tp=RIGHT((bi*100)%bt,2)'%'
    CALL WRITECH(STDOUT,'080808'x||tp)
  END
RETURN


cleanline:
ARG lflag .
IF colorflag~=1 & lflag=1 THEN RETURN
cline=lineup||LEFT(' ',78)
IF lflag=1 THEN cline=cline||lineup
SAY cline||CR
RETURN


getinput:
PARSE ARG upflag' 'oneflag' 'pline
CALL checkdcd()
OPTIONS PROMPT pline
PARSE PULL inarg
inarg=STRIP(inarg)
IF upflag THEN inarg=UPPER(inarg)
IF oneflag THEN inarg=LEFT(inarg,1)
inarg=cleanstring(0':'inarg)
RETURN inarg


docity:
PARSE ARG citi
citi=TRANSLATE(citi,'          ','+-.,*/()<>')
DO i=WORDS(citi) TO 1 BY -1
  IF DATATYPE(WORD(citi,i),'N') THEN citi=STRIP(DELWORD(citi,i,1))
  IF UPPER(WORD(citi,i))='USA' THEN citi=STRIP(DELWORD(citi,i,1))
END
citi=SPACE(citi,1)
RETURN STRIP(citi)


postuser:
IF bbsprefs.12~=1 THEN RETURN
ARG upflag .
IF upflag=6 THEN ptext='Logoff:' DATE() TIME('C')'  'name city
ELSE IF upflag=7 THEN ptext=name'  is a NEW USER!'
ELSE ptext='LogOn:' logontime'  'name city'  Last On:' DATE(,lastondate,'I')
ptext=CENTER(ptext,74)'\'
age='?'
IF UPPER(WORD(data.12,3))='BIRTHDAY:' THEN
  DO
    IF DATATYPE(WORD(data.12,4),'W') THEN
      DO
        age=LEFT(DATE('S'),4)-LEFT(WORD(data.12,4),4)
        IF SUBSTR(DATE('S'),5,2)<SUBSTR(WORD(data.12,4),5,2) THEN age=age-1
      END
  END
IF age='?' & WORD(data.12,4)~='' THEN age=WORD(data.12,4)
ptext=ptext||CENTER('Baud:' bps'   Age:' age'   Usage:' data.19,74)'\'
ptext2=''
ptext1=data.1'   '
IF DATATYPE(WORD(data.12,1),'W') THEN
  ptext2=ptext2'   First On:' DATE(,WORD(data.12,1),'S')
n=74-LENGTH(ptext1)-LENGTH(ptext2)
ptext2=ptext1||STRIP(LEFT(data.9,n))||ptext2
ptext=ptext||CENTER(ptext2,74)'\'
ulb=WORD(data.14,3)
IF ~DATATYPE(ulb,'W') | ulb=0 THEN ulb=1
dlb=WORD(data.15,3)
IF ~DATATYPE(dlb,'W') THEN dlb=0
dlup=TRUNC(dlb/ulb+.005,2)
line3='Level: 'level'   dl/ul:' dlup
IF upflag=0 THEN ptext=ptext||CENTER(line3,74)
IF upflag=1 THEN ptext=ptext||CENTER(line3'   Cmd:' opt arg,74)
IF upflag=2 THEN ptext=ptext||CENTER(line3'   MSG:' msg.msgdir,74)
IF upflag=3 THEN ptext=ptext||CENTER(line3'   Email',74)
IF upflag=4 THEN ptext=ptext||CENTER(line3'   ul:' arg 'in' plaindir,74)
IF upflag=5 THEN ptext=ptext||CENTER(line3'   dl:' arg 'in' plaindir,74)
IF upflag=6 THEN ptext=ptext||CENTER(line3'   Elapsed:'elapsed' ',74)
IF GETCLIP('BBS_fkeyhelp')=1 THEN CALL PostMsg(3,11,ptext)
ELSE CALL PostMsg(lpost,rpost,ptext)
ptext2=''
IF EXISTS(bbspath'Email/'sysop'/NEW_FILES') THEN ptext2='NEW_FILES !'
IF EXISTS(bbspath'Lists/CBV_USERS') THEN ptext2=ptext2 'CBV_USERS !'
IF EXISTS(bbspath'Lists/NEW_USERS') THEN ptext2=ptext2 'NEW_USERS !'
IF chatrequest=1 THEN ptext2=ptext2 'CHAT REQUEST !'
ptext2=STRIP(ptext2)
IF ptext2='' THEN CALL PostMsg(,,'\\\\ ')
ELSE CALL PostMsg(,,'\\\\ 'CENTER('!' ptext2,74))
RETURN


whodat:
MSG RIGHT(' ',66-LENGTH(name)) '1B'x'M'||''||''||' 'name' level 'level' '||''
RETURN


showtime:
mins=TIME('E')%60
secs=TRUNC(TIME('E')//60)+1
IF secs>59 THEN secs=59
IF secs<10 THEN secs='0'secs
line=' Time:  Used' mins':'secs
mins=(maxtime-TIME('E'))%60
secs=TRUNC((maxtime-TIME('E'))//60)
IF secs<10 THEN secs='0'secs
line=line'   Remaining' mins':'secs
SAY line||CR

checktime:
IF TIME('E')>maxtime THEN
  DO
    SAY 'Sorry,' name 'your time has expired.'CR
    CALL send2log('*** Time Expired ***')
    SIGNAL LOGOUT2
  END
IF TIME('E')>(maxtime-120) THEN SAY '*** Less than 2 minutes left! ***'CR
CALL whodat()
CALL checkdcd()
RETURN


setdir:
PARSE ARG tempdir
CALL PRAGMA('D',STRIP(tempdir))
directory=PRAGMA('D')
Data directory
slash=LASTPOS('/',directory)
IF slash=0 THEN slash=LASTPOS(':',directory)
plaindir=directory
IF slash>0 THEN plaindir=SUBSTR(plaindir,slash+1)
RETURN


config:
arg='s:CONFIG.BBS'
IF ~EXISTS(arg) THEN arg='BBS:BBS_TEXT/CONFIG.BBS'
IF readlines(arg 1) THEN
  DO
    SAY 's:CONFIG.BBS and BBS:BBS_TEXT/CONFIG.BBS are both missing!'CR
    SIGNAL DONE2
  END
compos=POS('/*',lynes.1)
IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
bbsname=STRIP(lynes.1)
sysop=WORD(lynes.2,1)
compos=POS('/*',lynes.3)
IF compos>0 THEN lynes.3=LEFT(lynes.3,compos-1)
exclusion=STRIP(lynes.3)
bbsdevice=WORD(lynes.4,1)
sysoplevel=WORD(lynes.5,1)
bbspath=WORD(lynes.6,1)
IF ~EXISTS(bbspath) THEN
  DO
    SAY bbspath 'does not exist!'CR
    SIGNAL DONE2
  END
testchar=RIGHT(bbspath,1)
IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
CALL SETCLIP('BBS_path',bbspath)
msgpath=WORD(lynes.7,1)
IF ~EXISTS(msgpath) THEN
  DO
    SAY msgpath 'does not exist!'CR
    SIGNAL DONE2
  END
testchar=RIGHT(msgpath,1)
IF testchar~='/' & testchar~=':' THEN msgpath=msgpath'/'
CALL SETCLIP('BBS_msgpath',msgpath)
msgpath=msgpath'MSG'
libpath=WORD(lynes.8,1)
IF ~EXISTS(libpath) THEN
  DO
    SAY libpath 'does not exist!'CR
    SIGNAL DONE2
  END
testchar=RIGHT(libpath,1)
IF testchar~='/' & testchar~=':' THEN libpath=libpath'/'
CALL SETCLIP('BBS_libpath',libpath)
extdevs=''
DO i=1 TO WORDS(lynes.10)
  test=WORD(lynes.10,i)
  IF POS(':',test)=0 THEN ITERATE i
  IF LEFT(test,2)='/*' THEN LEAVE i
  extdevs=STRIP(extdevs test)
END
SYSTEM_MSG_LIMIT=WORD(lynes.11,1)
SYSTEM_SPACE_LIMIT=WORD(lynes.12,1)
maxidle=WORD(lynes.13,1)
maxtime=WORD(lynes.14,1)
maxbps=WORD(lynes.15,1)
IF ~DATATYPE(maxbps,'W') THEN maxbps=2400
CALL SETCLIP('BBS_baud',maxbps)
DO i=16 TO 40
  j=i-15
  bbsprefs.j=STRIP(WORD(lynes.i,1))
END
spellpath=WORD(lynes.9,1)
IF bbsprefs.5 & ~EXISTS(spellpath) THEN
  DO
    SAY spellpath 'does not exist!'CR
    bbsprefs.5=0
  END
IF bbsprefs.10 THEN scratch=bbspath'Scratch'
ELSE scratch='RAM:Scratch'
CALL MAKEDIR(scratch)
IF ~DATATYPE(bbsprefs.16,'W') THEN bbsprefs.16=3
extension=WORD(lynes.32,1)
arccom=lynes.33
compos=POS('/*',lynes.33)
IF compos>0 THEN lynes.33=LEFT(lynes.33,compos-1)
arccom=STRIP(lynes.33)
IF LEFT(extension,1)~='.' THEN
  DO
    extension='.lzh'
    arccom='lharc -m m'
  END
lpost=WORD(lynes.34,1)
IF ~DATATYPE(lpost,'W') THEN lpost=3
rpost=WORD(lynes.35,1)
IF ~DATATYPE(rpost,'W') THEN rpost=14
compos=POS('/*',lynes.42)
IF compos>0 THEN lynes.42=LEFT(lynes.42,compos-1)
bbsprefs.27=STRIP(lynes.42)
RETURN


readlogs:
IF arg='' THEN
  arg=getinput(1 0 '['pen3'RETURN'def']=TODAY, or enter Log Date ('pen3||DATE('S')||def') > ')
IF arg='' THEN arg=DATE('S')
arg=bbspath'Logs/log.'arg
CALL readlines(arg 1)
CALL seelines(0)
nonstop=0
CALL waiting()
RETURN


loadcourtesy:
IF courtesyflag=0 & courtesy='' & EXISTS(bbspath'Lists/Courtesy') THEN
  DO
    IF readopen(bbspath'Lists/Courtesy') THEN
      DO
        SAY 'Checking Courtesy List...'CR
        DO i=1
          line=READLN(f)
          IF EOF(f) THEN BREAK
          line=cleanstring(1':'line)
          courtesy=courtesy line
        END
        CALL CLOSE(f)
        MSG ''
        MSG pen3'Courtesy List:'def
        MSG courtesy
      END
  END
RETURN


fileheader:
SAY 'Filename          Bytes File# Library         KeyWords'CR
SAY pen3||LEFT('=',77,'=')||def||CR
RETURN


showalpha:
IF DATATYPE(arg,'W') THEN
  DO
    dirnum=arg
    arg=''
    IF chdir2()>0 THEN RETURN
    test='Y'
  END
ELSE
  DO
    test=getinput(1 1 'Show one library only? (Ny) > ')
    IF test='Y' THEN
      DO
        IF chdir()>0 THEN RETURN
      END
  END

showalpha2:
IF test='Y' THEN filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir))
ELSE filecount=files.0
SAY '  'filecount 'files.'CR
CALL fileheader()
count=0
DO wi=1 TO alpha.0
  CALL busywait(60 wi alpha.0)
  IF test='Y' THEN
    DO
      IF count>=filecount THEN LEAVE wi
      IF UPPER(LEFT(plaindir,12))~=UPPER(LEFT(WORD(alpha.wi,5),12)) THEN
        ITERATE wi
    END
  jj=WORD(alpha.wi,4)
  IF jj>level | FIND(data.21,UPPER(dirs.jj))>0 THEN
    ITERATE wi
  CALL busywait(4 0)
  SAY alpha.wi||CR
  count=count+1
  IF (count+2)//linesperpage=0 THEN
    IF waiting2() THEN LEAVE wi
  CALL busywait(4 1)
END
CALL busywait(4 0)
nonstop=0
IF waitchar~='Q' THEN CALL waiting()
RETURN


profiles:
prodir=bbspath'Profiles'
CALL MAKEDIR(prodir)
pros=SHOWDIR(prodir)
protxt=bbspath'BBS_TEXT/PROFILES'
IF EXISTS(protxt) THEN CALL showtext(protxt)
DO lupe=1
  SAY CR
  SAY '       1. Edit 'name'''s user Profile'CR
  SAY '       2. View a User Profile'CR
  SAY '       3. Search User Profiles'CR
  SAY '       4. Browse User Profiles'CR
  SAY CR
  temp=getinput(1 1 'Enter Selection Number > ')
  IF temp=1 THEN
    DO
      lynes.=''
      IF EXISTS(prodir'/'name) THEN
        DO
          IF readlines(prodir'/'name 1)~=0 THEN ITERATE lupe
          CALL DELETE(prodir'/'name)
        END
      ELSE lynes.0=3
      lynes.1=name
      lynes.2='Profile Last Updated:' DATE('W') DATE() TIME('C')
      lynes.3=LEFT('=',74,'=')
      IF savelines(prodir'/'name)~=0 THEN
        DO
          line='Profile for' name 'failed to save!'
          SAY line||CR
          CALL send2log(line)
          ITERATE lupe
        END
      edtype=''
      CALL bbsEd(4 prodir'/'name)
      IF readlines(prodir'/'name 1)~=0 THEN CALL DELETE(prodir'/'name)
      IF lynes.0<4 THEN CALL DELETE(prodir'/'name)
      pros=SHOWDIR(prodir)
    END
  ELSE IF temp=2 THEN
    DO pf=1
      totpros=WORDS(pros)
      DO pfl=1 TO totpros BY 3
        pfl2=pfl+1
        pfl3=pfl+2
        pfline=pen3||RIGHT(pfl,3)||def LEFT(WORD(pros,pfl),21)
        IF pfl2<=totpros THEN
          pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(WORD(pros,pfl2),21)
        IF pfl3<=totpros THEN
          pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(WORD(pros,pfl3),21)
        SAY pfline||CR
        IF nonstop~=1 & ((pfl3%3)//linesperpage)=0 THEN
          IF waiting(2) THEN LEAVE pfl
      END
      emnum=getinput(1 0 pen3'Select User Profile Number > 'def)
      IF DATATYPE(emnum,'W') & emnum>0 & emnum<=totpros THEN
        DO
          tmp=WORD(pros,emnum)
          IF level>sysoplevel THEN
            DO
              CALL bbsEd(1 prodir'/'tmp)
              IF readlines(prodir'/'tmp 1)~=0 THEN CALL DELETE(prodir'/'tmp)
              IF lynes.0<4 THEN CALL DELETE(prodir'/'tmp)
              pros=SHOWDIR(prodir)
            END
          ELSE CALL showtext(prodir'/'tmp)
        END
      ELSE LEAVE pf
    END
  ELSE IF temp=3 | temp=4 THEN
    DO
      searcharg=''
      nonstop=0
      IF temp=3 THEN
        DO
          searcharg=STRIP(getinput(0 0 'Enter Search Phrase > '))
          IF searcharg='' THEN ITERATE lupe
        END
      DO ui=1 TO WORDS(pros)
        pro=prodir'/'WORD(pros,ui)
        IF temp=3 THEN
          IF textsearch(pro searcharg)=0 THEN ITERATE ui
        SAY CR
        CALL readlines(pro 1)
        IF nonstop=1 THEN rnonstop=1
        ELSE rnonstop=0
        CALL seelines(2)
        IF rnonstop THEN nonstop=1
        ELSE IF waiting2()=1 THEN LEAVE ui
        SAY CR
        SAY CR
      END
    END
  ELSE IF temp='' | LEFT(temp,1)='Q' THEN LEAVE lupe
END
DROP pros
RETURN


otheruser:
line=''
IF level>sysoplevel THEN line='['pen3'R'def']eport or'
line=line '['pen3'D'def']etails or simple ['pen3'N'def']amelist?'
IF level>sysoplevel THEN line=line '(Dnr) > '
ELSE line=line '(Dn) > '
temp=getinput(1 1 line)
IF temp='N' THEN
  DO
    CALL showuserlist()
    RETURN
  END
ELSE IF level>sysoplevel & temp='R' THEN
  DO
    SAY CR
    line=''
    IF getinput(1 1 'Report on inactive users? (nY) > ')~='N' THEN
      DO
        CALL cleanline(0)
        SAY 'INACTIVE_USERS report will be in your email.'CR
        line='USERS '
      END
    IF getinput(1 1 'Report on actual files vs. filelists? (nY) > ')~='N' THEN
      DO
        CALL cleanline(0)
        line=line'FILES'
        line=STRIP(line getinput(1 0 'Report only files larger than (0) bytes > '))
        SAY 'FILELISTS_REPORT will be in your email.'CR
      END
    SAY CR
    ADDRESS AREXX bbsREPORT.rexx name line
    RETURN
  END
SAY CR
SAY 'To allow (or not) other users to see your street address and/or phone number,'CR
SAY 'add (or delete) STREET and/or PHONE to the line 8 list in ['pen3'Y'def']our userfile.'CR
SAY CR
SAY 'User specification may include ? wildcard for single characters.'CR
SAY 'ie,' pen3's?n'def 'will return all user names containing ''son'', ''sen'', ''sin'', etc.'CR
IF arg='' THEN arg=getinput(1 0 pen3'User specification: 'def)
IF arg='' THEN RETURN
arg=TRANSLATE(STRIP(arg),'_',' ')
CALL FileList(bbspath'Users/*'arg'*',wildlist)
line='Found' wildlist.0 'match'
IF wildlist.0~=1 THEN line=line'es'
SAY line'.'CR
IF wildlist.0<1 THEN RETURN
totlines=0
nextpagebreak=linesperpage-3
extrainfo=0
IF level>sysoplevel THEN
  DO
    IF getinput(1 1 'Display -sysop only- information? (nY) > ')~='N' THEN
      extrainfo=1
  END
DO i=1 TO wildlist.0
  CALL readlines(wildlist.i 1)
  SAY CR
  totlines=totlines+6
  SAY bak2' 'SUBSTR(wildlist.i,LASTPOS('/',wildlist.i)+1)' 'def||CR
  SAY lynes.1||CR
  IF FIND(UPPER(lynes.8),'STREET')>0 THEN
    DO
      totlines=totlines+1
      SAY lynes.2||CR
    END
  SAY lynes.3||CR
  IF FIND(UPPER(lynes.8),'PHONE')>0 THEN
    DO
      totlines=totlines+1
      SAY lynes.4||CR
    END
  SAY 'Last time on' bbsname':' DATE(,WORD(lynes.13,1),'S') WORD(lynes.13,2)||CR
  SAY pen3'Interests:'def lynes.10||CR
  IF extrainfo THEN
    DO
      SAY pen3'   up:'def lynes.14||CR
      SAY pen3' down:'def lynes.15||CR
      temptot=0
      DO j=1 TO WORDS(lynes.23)
        IF DATATYPE(WORD(lynes.23,j),'W') THEN temptot=temptot+WORD(lynes.23,j)
      END
      SAY pen3' writ:'def temptot 'public messages.'CR
      SAY pen3'level:'def lynes.20||CR
      totlines=totlines+4
      IF lynes.21~='' THEN
        DO
          totlines=totlines+1
          SAY pen3'excluded dirs:'def lynes.21||CR
        END
    END
  IF nonstop~=1 & totlines>=nextpagebreak THEN
    DO
      IF waiting2() THEN LEAVE i
      nextpagebreak=totlines+linesperpage-5
    END
END
nonstop=0
DROP wildlist.
IF waitchar~='Q' THEN CALL waiting()
RETURN


changename:
ARG cname
IF level<=sysoplevel THEN RETURN
IF cname='' THEN cname=getinput(1 0 'Current Username (include underscore): ')
IF readlines(bbspath'Users/'cname 1)>0 THEN RETURN
IF WORD(lynes,20)>=level THEN RETURN
CALL SETCLIP('BBS_oldname',cname)
CALL ChangeUserName.rexx()
ncname=GETCLIP('BBS_newname')
IF GETCLIP('BBS_oldname')='' THEN
  CALL send2log('Name change from' cname 'to' ncname)
CALL DELETE(bbspath'Lists/USERS')
sortuserflag=1
CALL SETCLIP('BBS_oldname')
CALL SETCLIP('BBS_newname')
RETURN ncname


levelreport:
minlev=0
maxlev=99
templist=''
uname=''
newufile=bbspath'Lists/NEW_USERS'
IF EXISTS(newufile) THEN
  DO
    IF getinput(1 1 'Latest New Users Only? (nY) > ')~='N' THEN
      DO
        IF readlines(newufile 1)=0 THEN
          DO i=2 TO lynes.0
            templist=STRIP(templist WORD(lynes.i,3))
          END
      END
    ELSE newufile=''
  END
ELSE newufile=''
IF newufile='' THEN
  DO
    minlev=getinput(1 0 'Minimum level? (0) > ')
    maxlev=getinput(1 0 'Maximum level? (99) > ')
    IF ~DATATYPE(minlev,'W') THEN minlev=0
    IF ~DATATYPE(maxlev,'W') THEN maxlev=99
    IF minlev<0 | minlev>99 THEN minlev=0
    IF maxlev<0 | maxlev>99 THEN maxlev=99
    templist=userlist
  END
DO levi=1 TO WORDS(templist)
  arg=bbspath'Users/'WORD(templist,levi)
  CALL readlines(arg 1)
  lt=WORD(lynes.20,1)
  IF ~DATATYPE(lt,'W') THEN lt=0
  IF lt<minlev | lt>maxlev THEN ITERATE levi
  line=lt WORD(templist,levi)
  SAY line||CR
  IF newufile~='' | lt<10 THEN
    DO
      SAY CR||LF||line||CR
      DO levj=1 TO 12
        SAY pen3'  'lynes.levj||def||CR
      END
      SAY pen3'  'lynes.19||def||CR
    END
  ELSE ITERATE levi
  lcom=''
  IF lt<10 THEN lcom='['pen3'A'def']dd  '
  lcom=lcom'['pen3'K'def']ill  ['pen3'R'def']ename  ['pen3'S'def']kip this user?'
  IF lt<10 THEN lcom=lcom' (Akrs) > '
  ELSE lcom=lcom '(krS) > '
  lcom=getinput(1 1 lcom)
  CALL cleanline(0)
  IF lcom='K' THEN
    DO
      arg=WORD(templist,levi)
      CALL killuser()
    END
  ELSE IF lcom='R' THEN
    DO
      newname=changename(WORD(templist,levi))
      IF newname~='' & newname~=WORD(templist,levi) THEN
        DO
          temp=WORDINDEX(templist,levi+1)
          rtemp=''
          IF temp>0 THEN rtemp=SUBSTR(templist,temp)
          temp=WORDINDEX(templist,levi)
          templist=''
          IF temp>2 THEN templist=STRIP(LEFT(templist,temp-1))
          templist=STRIP(templist newname rtemp)
          userlist=userlist newname
        END
      levi=levi-1
      CALL SETCLIP('BBS_newname')
    END
  ELSE IF lcom~='S' & lt<10 THEN
    DO
      IF readopen(bbspath'BBS_TEXT/DEF.MEMBER') THEN
        DO
          DO lvi=1 TO 22
            line=READLN(f)
            IF lvi=11 THEN lynes.11=line
            IF lvi=20 THEN lynes.20=line
            IF lvi=21 THEN lynes.21=line
          END
          lynes.22=line
          CALL CLOSE(f)
          edtype=''
          IF bbsprefs.25=1 THEN
            DO
              SAY CR
              lynes.22=''
              lynes.23=''
              IF DATATYPE(lynes.20,'W') THEN
                DO
                  SAY 'Setting message counters to last 10 messages in each conference...'CR
                  DO i=1 TO lynes.20
                    num=countcheck(bbspath'Numbers/LastMessage'i 0)-10
                    IF num<0 | msg.i.0<10 THEN num=0
                    lynes.22=lynes.22 num
                    lynes.23=lynes.23 0
                  END
                END
              ELSE CALL send2log('Bad default level in BBS_TEXT/DEF.MEMBER file!')
              SAY 'Setting file counter to last file uploaded...'CR
              lynes.16=countcheck(bbspath'Numbers/LastFile' 0)
              lynes.16=lynes.16 '19900101 00:00:00'
            END
          lynes.0=27
          CALL savelines(arg)
          SAY lynes.20 WORD(templist,levi) 'has been made a member.'CR
        END
      ELSE SAY 'You need a default member file in BBS_TEXT!  ( BBS_TEXT/DEF.MEMBER )'CR
    END
  IF lcom~='K' & lcom~='R' & newufile~='' THEN
    DO
      nlt=getinput(1 0 lynes.20 'Enter new level or blank for no change. > ')
      IF DATATYPE(nlt,'W') THEN
        DO
          lynes.20=nlt
          CALL savelines(arg)
        END
      CALL writenew()
    END
END
IF newufile~='' & EXISTS(newufile) THEN
  IF getinput(1 1 'Delete NEW_USERS file? (nY) > ')~='N' THEN CALL DELETE(newufile)
IF EXISTS(bbspath'Lists/CBV_USERS') THEN
  IF getinput(1 1 'Delete CBV_USERS file? (nY) > ')~='N' THEN
    CALL DELETE(bbspath'Lists/CBV_USERS')
DROP templist
RETURN


writenew:
arg=WORD(templist,levi)
IF getinput(1 1 'Write' arg 'an email message? (nY) > ')~='N' THEN
  DO
    IF EXISTS(bbspath'BBS_TEXT/EMAIL_WELCOME') THEN
      IF getinput(1 1 'Use default welcome? (nY) > ')~='N' THEN replysubj='|@NEW@|'
    CALL editor('MAIL' arg)
  END
RETURN


filereport:
SAY 'Searching for mismatches between files and filenotes...'CR
DO i=1 TO sysoplevel+1
  IF dirs.i='' THEN ITERATE
  SAY dirs.i'                               'lineup||CR
  rfiles=SHOWDIR(libpath||dirs.i)
  rnotes=SHOWDIR(bbspath'FileNotes/'dirs.i)
  IF WORDS(rfiles)~=WORDS(rnotes) THEN
    DO
      line='Compare files & filenotes in'pen3 dirs.i||def'. '
      DO j=1 TO WORDS(rfiles)
        IF FIND(UPPER(rnotes),UPPER(WORD(rfiles,j)))=0 THEN
          line=line WORD(rfiles,j)
      END
      SAY line||CR
    END
END
Send '^G'
CALL waiting()
RETURN


mailreport:
SAY 'Checking ALL pending Email...'CR
SAY pen3' - Use CTRL-E to Exit -'def||CR
SAY CR
mailrep=SHOWDIR(bbspath'Email','D')
mailfil=SHOWDIR(bbspath'EmailFiles','D')
lastemail=WORD(data.17,3)
IF ~DATATYPE(lastemail,'W') THEN lastemail=0
IF lastemail=countcheck(bbspath'Numbers/LastMail' 0) THEN
  DO
    DROP mailrep. mailfil.
    RETURN
  END
mailynes.=''
mk=0
DO mi=1 TO WORDS(mailrep)
  muser=WORD(mailrep,mi)
  IF muser=sysop | muser=name THEN ITERATE mi
  mlist=SHOWDIR(bbspath'Email/'muser)
  IF WORDS(mlist)>0 THEN SAY lineup||RIGHT(muser,40)||CR
  DO mj=1 TO WORDS(mlist)
    fuser=WORD(mlist,mj)
    IF POS(sysop,fuser)>0 THEN ITERATE mj
    IF logonflag=0 THEN
      DO
        mk=mk+1
        mailynes.mk=pen3||LEFT(muser,20) 'from'def LEFT(fuser,20) DATE(,WORD(STATEF(bbspath'Email/'muser'/'fuser),5),'I')
      END
    IF POS(sysop,fuser)=0 & POS(name,fuser)=0 THEN
      DO
        testnum=RIGHT(fuser,LENGTH(fuser)-LASTPOS('.',fuser))
        IF testnum>emailnum THEN emailnum=testnum
        IF testnum>lastemail THEN
          DO
            CALL showtext(bbspath'Email/'muser'/'fuser)
            SAY CR
            SAY CR
            IF waitchar='Q' THEN LEAVE mi
          END
      END
  END
  IF logonflag=0 & FIND(mailfil,muser)>0 THEN
    DO
      efilelist=SHOWDIR(bbspath'EmailFiles/'muser)
      IF WORDS(efilelist)>0 THEN
        DO
          mk=mk+1
          mailynes.mk=pen3||LEFT(muser,20) 'emailfiles'def efilelist
        END
    END
END
data.17=WORD(data.17,1) WORD(data.17,2) countcheck(bbspath'Numbers/LastMail' 0)
IF mk>0 THEN
  DO
    lynes.0=mk
    DO mi=1 TO mk
      lynes.mi=mailynes.mi
    END
    CALL seelines(1)
    nonstop=0
    CALL waiting()
  END
ELSE SAY 'No unseen Email pending.'CR
DROP mailrep. mailfil. mailynes. mlist
RETURN


sortdoors:
IF ~DATATYPE(jdoors.0,'W') THEN doors.0=0
IF WORDS(SHOWDIR(bbspath'rexxDoors','F'))~=doors.0 THEN
  DO
    jdoors.=''
    doorlist=SHOWDIR(bbspath'rexxDoors','F')
    doors.=''
    doors.0=WORDS(doorlist)
    DO i=1 TO doors.0
      doors.i=WORD(doorlist,i)
    END
    SAY 'Sorting..'lineup||CR
    CALL QSORT(1,doors.0,doors)
    jdoors.0=doors.0%3
    IF (doors.0//3)>0 THEN jdoors.0=jdoors.0+1
    DO i=1 TO jdoors.0
      DO j=0 TO 2
        k=i+j*jdoors.0
        IF k<=doors.0 THEN
          DO
            jdoors.i=jdoors.i' 'LEFT(RIGHT(k,3)'.' LEFT(doors.k,LENGTH(doors.k)-5),24)
            dcount=WORD(STATEF(bbspath'rexxDoors/'doors.k),8)
            jdoors.i.0=jdoors.i.0||LEFT(RIGHT(dcount,5) LEFT(doors.k,LENGTH(doors.k)-5),24)' '
          END
      END
    END
  END
RETURN 0


jump2rexx:
CALL sound('JUMP')
CALL sortdoors()
temp=1
readcount=-1
DO doorloop=1
  IF temp=0 THEN
    DO
      IF readcount~=-1 THEN
        DO
          doors.0=''
          CALL sortdoors()
        END
      SAY CENTER('- Number of accesses per file -',75)||CR
    END
  SAY pen3||LEFT('-',75,'-')||def||CR
  DO jd=1 TO jdoors.0
    IF temp=0 THEN SAY jdoors.jd.0||CR
    ELSE SAY jdoors.jd||CR
    IF jd//linesperpage=0 THEN CALL waiting()
    IF waitchar='Q' THEN LEAVE doorloop
  END
  IF temp=0 THEN
    DO
      CALL waiting()
      temp=1
      ITERATE doorloop
    END
  temp=getinput(1 0 pen3'Select Application Number. 0=Stats > 'def)
  IF temp=0 THEN ITERATE doorloop
  IF ~DATATYPE(temp,'W') | temp<1 | temp>doors.0 THEN LEAVE doorloop
  IF TIME('E')>(maxtime-120) THEN
    DO
      SAY CR
      SAY '*** Less than 2 minutes left! ***'CR
      SAY '***   rexxDoors are closed!   ***'CR
      SAY CR
      LEAVE doorloop
    END
  arg=doors.temp
  IF GETCLIP('BBS_localdoor')=arg THEN
    DO
      SAY 'That door is in use!  Try again in a few minutes...'CR
      ITERATE doorloop
    END
  CALL SETCLIP('BBS_door',arg)
  readcount=WORD(STATEF(bbspath'rexxDoors/'arg),8)
  IF ~DATATYPE(readcount,'W') THEN readcount=0
  ADDRESS COMMAND 'C:filenote' bbspath'rexxDoors/'arg readcount+1
  CALL postuser(1)
  curdir=PRAGMA('D')
  CALL setdir(bbspath'rexxDoors')
  CALL send2log('Door: 'doors.temp 'at' TIME('C'))
  CALL SETCLIP('BBS_winnings')
  savewinnings=0
  timeleft=TRUNC(maxtime-TIME('E'))
  IF UPPER(doors.temp)='ONE_ARMED_BANDIT.REXX' THEN
    IF getinput(1 1 'Play for this sessions time in seconds? (Ny) > ')='Y' THEN
      DO
        savewinnings=winnings
        IF savewinnings=0 THEN savewinnings=1
        winnings=timeleft
        SAY 'Playing for REAL seconds, not wimpy play-dollars!'CR
      END
  comm='CALL' doors.temp'('name winnings savewinnings colorflag timeleft-42')'
  INTERPRET comm
  testwin=GETCLIP('BBS_winnings')
  IF DATATYPE(testwin,'N') THEN
    DO
      IF savewinnings>0 THEN
        DO
          IF testwin>7200 THEN
            DO
              SAY 'Although you won' TRUNC(testwin/60) 'minutes, the maximum session time is 120 minutes.'CR
              testwin=7200
            END
          maxtime=TRUNC(testwin+TIME('E'))
          winnings=savewinnings
        END
      ELSE winnings=testwin
    END
  CALL setdir(curdir)
  CALL SETCLIP('BBS_winnings')
  CALL SETCLIP('BBS_door')
  SAY CR
  CALL showtime()
END
CALL SETCLIP('BBS_winnings')
CALL SETCLIP('BBS_door')
RETURN


sortlibraries:
SAY 'Sorting Libraries...'CR
count=0
sdirs.=''
DO i=1 TO level
  IF dirs.i='' THEN ITERATE i
  count=count+1
  sdirs.count=dirs.i i
END
sdirs.0=count
CALL QSort(1,count,sdirs)
count=0
libs.=''
DO i=1 TO sdirs.0
  tempnum=WORD(sdirs.i,2)
  tempdir=WORD(sdirs.i,1)
  IF FIND(data.21,UPPER(tempdir))=0 THEN
    DO
      string=' '
      IF tempnum<10 THEN string=string' '
      string=string || tempnum'. 'LEFT(tempdir,14)
      count=count+1
      libs.count=string
    END
END
libs.0=count%4
IF (count//4)>0 THEN libs.0=libs.0+1
DO i=1 TO libs.0
  DO j=1 TO 3
    k=i+j*libs.0
    IF k<=count THEN libs.i=libs.i||libs.k
  END
END
DROP sdirs.
CALL sortconferences()
RETURN


sortconferences:
SAY 'Sorting Conferences...'CR
count=0
smsg.=''
DO i=1 TO level
  IF msg.i='' THEN ITERATE i
  count=count+1
  smsg.count=msg.i i
END
smsg.0=count
CALL QSort(1,count,smsg)
count=0
msgs.=''
DO i=1 TO smsg.0
  tempnum=WORD(smsg.i,2)
  tempdir=WORD(smsg.i,1)
  IF FIND(data.21,tempnum)=0 THEN
    DO
      string=' '
      IF tempnum<10 THEN string=string' '
      string=string || tempnum'.'
      IF WORD(data.22,tempnum)='' | WORD(data.22,tempnum)>=0 THEN
        string=string LEFT(tempdir,20)
      ELSE string=string pen3'-OFF-'def LEFT(tempdir,14)
      count=count+1
      msgs.count=string
    END
END
msgs.0=count%3
IF (count//3)>0 THEN msgs.0=msgs.0+1
DO i=1 TO msgs.0
  DO j=1 TO 2
    k=i+j*msgs.0
    IF k<=count THEN msgs.i=msgs.i msgs.k
  END
END
DROP smsg.
RETURN


readmessages:
searcharg=''
DO FOREVER
  SAY CR
  PARSE VAR arg temp' 'arg .
  IF DATATYPE(temp,'W') THEN msgdir=temp
  ELSE IF LEFT(UPPER(temp),1)='A' THEN
    DO
      CALL newmsgs()
      arg=''
      RETURN
    END
  ELSE IF LEFT(UPPER(temp),1)='M' THEN
    DO
      CALL readmarked()
      arg=''
      RETURN
    END
  ELSE
    DO
      SAY 'Select Message Conference By Number, ['pen3'M'def']arked only or ['pen3'A'def']ll Active'CR
      IF areaselect() THEN
        DO
          IF LEFT(temp,1)='A' THEN CALL newmsgs()
          IF LEFT(temp,1)='M' THEN CALL readmarked()
          RETURN
        END
    END
  pline='['pen3'A'def']rchive ['pen3'S'def']earch ['pen3'T'def']oggle ON/OFF'
  pline=pline '['pen3'R'def']ead ['pen3'Q'def']uit (aqRst) > '
  IF arg~='' THEN junk=UPPER(LEFT(arg,1))
  ELSE junk=getinput(1 1 pline)
  IF junk='Q' THEN RETURN
  IF junk='A' THEN
    DO
      SAY CR
      CALL msgcount(msgdir)
      junk=getinput(1 0 pen3'RETURN'def' to archive new msgs, ['pen3'Q'def']uit, or enter starting message number > ')
      IF junk='Q' THEN RETURN
      IF DATATYPE(junk,'W') THEN
        DO
          IF junk>lastmess | junk<1 THEN junk=1
          lastread.msgdir=junk-1
          CALL savedata(1)
        END
      CALL SETCLIP('BBS_MSGS','ON')
      SAY 'Archiving messages in the'pen3 msg.msgdir def'Conference...'CR
      lastread.msgdir=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
      CALL send2log('Arc: ArcMsgs.rexx' msg.msgdir)
      ADDRESS AREXX ArcMsgs.rexx name msgdir
      IF emailonline>=0 THEN emailonline=emailonline+1
      DO WHILE GETCLIP('BBS_MSGS')~=''
        CALL DELAY(14)
      END
      SAY 'When completed, the archive will be attached to email addressed to you.'CR
      CALL savedata(1)
      SAY CR
      RETURN
    END
  IF junk='S' THEN
    DO
      searcharg=''
      searcharg=getinput(0 0 pen3'Search Phrase: 'def)
      IF LENGTH(STRIP(searcharg))=0 THEN RETURN
      searcharg=COMPRESS(searcharg,'*')
      SAY CR
      CALL searchmsgdir()
      SAY CR
      SAY 'All messages in the'pen3 msg.msgdir def'Conference have been searched.'CR
      SAY CR
      CALL waiting()
      searcharg=''
      RETURN
    END
  IF junk='T' THEN
    DO
      line='Turning the' msg.msgdir 'conference'
      IF WORD(data.22,msgdir)<0 THEN
        DO
          line=line pen3'ON'def'.'
          newdata='0'
        END
      ELSE
        DO
          line=line pen3'OFF'def'.'
          newdata='-1'
        END
      SAY line||CR
      dataloc=WORDINDEX(data.22,msgdir)-1
      data.22=DELWORD(data.22,msgdir,1)
      IF dataloc>0 THEN data.22=INSERT(newdata' ',data.22,dataloc)
      CALL sortconferences()
    END
  CALL readmsg(0)
  CALL saveData(1)
  nonstop=0
  arg=''
END
RETURN


newmsgs:
test=UPPER(LEFT(arg,1))
IF test='' THEN
  test=getinput(1 1 '['pen3'R'def']ead new messages or ['pen3'A'def']rchive for later download. (aR) > ')
IF test='A' THEN
  DO
    CALL SETCLIP('BBS_MSGS','ON')
    SAY CR
    SAY 'Archiving new conference messages...'CR
    CALL send2log('Arc: ArcMsgs.rexx')
    ADDRESS AREXX ArcMsgs.rexx name
    IF emailonline>=0 THEN emailonline=emailonline+1
    clear_marked=1
    DO i=1 TO level
      IF WORD(data.22,i)~=-1 THEN
        lastread.i=countcheck(bbspath'Numbers/LastMessage'i 0)
    END
    DO WHILE GETCLIP('BBS_MSGS')~=''
      CALL DELAY(14)
    END
    SAY 'When completed, the archive will be attached to email addressed to you.'CR
    CALL savedata(1)
    SAY CR
    RETURN
  END
curmsgdir=msgdir
SAY 'Scanning all Conferences for new messages..'CR
DO newi=1 TO level
  IF msg.newi='' THEN ITERATE newi
  msgdir=newi
  CALL readmsg(1)
  IF msgcom='Q' THEN LEAVE newi
END
CALL saveData(1)
msgdir=curmsgdir
nonstop=0
RETURN


readmsg:
ARG quietflag marknum .
msgcom=''
IF msg.msgdir='' | FIND(data.21,msgdir)>0 THEN RETURN; /* sysop excluded */
IF WORD(data.22,msgdir)=-1 THEN RETURN;                /*  user excluded */
entering='Entering'pen3 msg.msgdir def'Message Conference..'
IF quietflag=0 & marknum='' THEN SAY entering||CR
CALL postuser(2)
IF DATATYPE(WORD(data.22,msgdir),'W') THEN
  lastread.msgdir=WORD(data.22,msgdir)
ELSE lastread.msgdir=0
lstwrt=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
frstwrt=countcheck(bbspath'Numbers/FirstMessage'msgdir 0)
temp=''
IF marknum='' THEN
  DO
    IF lastread.msgdir>=lstwrt | lastread.msgdir<frstwrt THEN
      DO
        lastread.msgdir=lstwrt
        CALL msgcount(msgdir)
        IF quietflag=1 & lastread.msgdir=lstwrt THEN RETURN
        IF nonstop=1 THEN temp=''
        ELSE temp=getinput(1 0 pen3'Enter starting message number > 'def)
        IF temp='' THEN temp=lastread.msgdir
        IF ~DATATYPE(temp,'W') THEN RETURN
        IF temp<frstwrt THEN temp=frstwrt
        IF temp>lstwrt THEN temp=lstwrt
        IF temp<1 THEN temp=1
        lastread.msgdir=temp-1
      END
  END
ELSE lastread.msgdir=marknum-1
IF quietflag=1 THEN SAY entering||CR
dirname=msgpath||msgdir
msglist.=0 /* set read to 0, unread to 1, and reply >=2 */
firstmess=999999
testlist=SHOWDIR(dirname)
DO i=1 TO WORDS(testlist)
  test=WORD(testlist,i)
  IF test>lastread.msgdir THEN msglist.test=1
  IF test<firstmess THEN firstmess=test
END
IF firstmess=999999 THEN firstmess=0
CALL countcheck(bbspath'Numbers/FirstMessage'msgdir firstmess)
msgstatus=1
IF temp='' & marknum='' THEN CALL msgcount(msgdir)
skipsubj.=''
skipsubj.0=0
DO msgloop=1
  lastreadnum=lastread.msgdir
  DO WHILE msglist.lastreadnum=0 & lastreadnum<lstwrt
    lastreadnum=lastreadnum+1
  END
  lastread.msgdir=lastreadnum
  IF lastreadnum=lstwrt & msglist.lstwrt=0 THEN LEAVE msgloop
  DO mess=lastread.msgdir TO lstwrt+1
    IF marknum~='' THEN
      DO
        IF mess>marknum THEN LEAVE msgloop
        mess=marknum
      END
    IF msglist.mess~=msgstatus THEN ITERATE mess
    IF msgstatus>1 THEN SAY 'Following the thread, level' msgstatus-1'.'CR
    msglist.mess=0
    arg=dirname'/'mess
    IF ~EXISTS(arg) THEN
      DO
        SAY 'Message number' mess 'is missing.'CR
        ITERATE mess
      END
    IF ~readopen(arg) THEN ITERATE mess
    firstline=READLN(f)
    secondline=READLN(f)
    thirdline=READLN(f)
    forthline=READLN(f)
    CALL CLOSE(f)
    CALL killmark(msgdir mess)
    DO skp=1 TO skipsubj.0
      IF forthline=skipsubj.skp THEN ITERATE mess
    END
    IF WORDS(firstline)>2 THEN /* if replies, change their num to >1 */
      DO
        thread=SUBSTR(firstline,WORDINDEX(firstline,4))
        DO tindx=1 TO WORDS(thread)
          test=WORD(thread,tindx)
          IF msglist.test~=0 THEN msglist.test=msgstatus+1
        END
      END
    savearg=arg
    msgcom='A'
    DO msgloop2=1 WHILE msgcom='A' | msgcom='O'
      CALL readlines(arg 1)
      IF nonstop=1 THEN rnonstop=1
      ELSE rnonstop=0
      CALL seelines(2)
      msgcom=''
      IF rnonstop THEN
        DO
          SAY CR
          nonstop=1
          msgcom=''
        END
      ELSE
        DO
          pline=''
          IF level<=sysoplevel | WORDS(lynes.3)<3 THEN pline='['pen3'A'def']gain'
          IF level>sysoplevel | name=WORD(lynes.2,2) THEN
            pline=pline '['pen3'E'def']dit ['pen3'K'def']ill'
          IF level>sysoplevel THEN pline=pline '['pen3'M'def']ove'
          IF WORDS(lynes.3)>3 THEN pline=pline '['pen3'O'def']riginal'
          pline=pline '['pen3'N'def']onStop ['pen3'R'def']eply'
          IF level=99 THEN pline=pline '['pen3'!'def']'
          pline=pline '['pen3'S'def']kip ['pen3'Q'def']uit ['pen3'?'def']'
          msgcom=getinput(1 0 STRIP(pline)' > ')
          CALL cleanline(0)
        END
      CALL checktime()
      IF DATATYPE(msgcom,'W') & EXISTS(dirname'/'msgcom) THEN
        DO
          arg=dirname'/'msgcom
          IF msgcom>lastread.msgdir THEN lastread.msgdir=msgcom
          msgcom='A'
          ITERATE msgloop2
        END
      ELSE msgcom=LEFT(msgcom,1)
      IF msgcom='Q' THEN LEAVE msgloop
      ELSE IF msgcom='!' & level>sysoplevel THEN
        DO
          CALL DELETE(arg)
          newchar=LEFT(lynes.1,1)
          IF newchar~='!' THEN newchar='!!'
          ELSE newchar='  '
          lynes.1=OVERLAY(newchar,lynes.1,1,2)
          CALL savelines(arg)
          ITERATE msgloop2
        END
      ELSE IF msgcom='A' THEN ITERATE msgloop2
      ELSE IF msgcom='M' & level>sysoplevel THEN
        DO
          prevmsgdir=msgdir
          If ~areaselect() THEN
            DO
              himsg=countcheck(bbspath'Numbers/LastMessage'msgdir 0)+1
              lynes.1='  Msg:' himsg
              lynes.3='   To:' WORD(lynes.3,2)
              lynes.5=STRIP(DELWORD(lynes.5,8,1)) msg.msgdir
              nlyn=lynes.0+1
              lynes.0=nlyn
              lynes.nlyn=' *** Moved from the' msg.prevmsgdir 'conference ***'
              CALL savelines(msgpath||msgdir'/'himsg)
              CALL countcheck(bbspath'Numbers/LastMessage'msgdir himsg)
              CALL msgmark(WORD(lynes.3,2) msgdir himsg)
              CALL readlines(arg 1)
              CALL DELETE(arg)
              CALL DELAY(28)
              lynes.0=7
              lynes.7='*** Moved to the' msg.msgdir 'conference, message #'himsg' ***'
              CALL savelines(arg)
            END
          msgdir=prevmsgdir
          msgcom='A'
        END
      ELSE IF msgcom='N' THEN
        DO
          nonstop=1
          msgcom=''
        END
      ELSE IF msgcom='H' | msgcom='?' THEN
        DO
          SAY pen3' - HELP with the Read Messages commands -'def||CR
          SAY ' RETURN reads the next message in line.'CR
          SAY ' 34 will read message number 34, if it exists in this conference.'CR
          SAY ' A  reads this message Again (in case it scrolled off screen).'CR
          IF level>sysoplevel | name=WORD(lynes.2,2) THEN
            DO
          SAY ' E  puts this message into the online Editor.'CR
          SAY ' K  deletes a message you wrote. you cannot Kill others!'CR
            END
          IF level>sysoplevel THEN
          SAY ' M  move this message to a new conference.'CR
          SAY ' N  displays all new messages without pausing. CTRL-E to Exit!'CR
          SAY ' O  if this message is a reply, will read the Original message.'CR
          SAY ' R  enters the message editor to Reply to this message.'CR
          SAY ' S  allows you to Skip threads or conferences.'CR
        IF level=99 THEN
          SAY ' !  toggles the do-not-purge! flag for this message.'CR
          SAY ' Q  returns to the message menu. (Quit)'CR
          SAY CR
          CALL waiting()
          msgcom='A'
          IF waitchar='Q' THEN LEAVE msgloop
        END
      ELSE IF msgcom='E' THEN
        DO
          IF level>sysoplevel | name=WORD(lynes.2,2) THEN
            DO
              sline=7
              IF level>sysoplevel THEN sline=1
              CALL bbsED(sline arg)
              msgcom='A'
            END
        END
      ELSE IF msgcom='S' & mess<lstwrt THEN
        DO
          stemp=''
          DO WHILE stemp~='T' & stemp~='C'
            stemp=getinput(1 1 'Skip this ['pen3'T'def']hread or the entire ['pen3'C'def']onference (ct) > ')
          END
          IF stemp='T' THEN
            DO
              SAY CR
              SAY pen3 forthline||def||CR
              SAY 'Skipping messages with this subject heading...'CR
              SAY CR
              DO i=lastread.msgdir TO lstwrt
                IF msglist.i>1 THEN msglist.i=0
              END
              skipsubj.0=skipsubj.0+1
              sksb=skipsubj.0
              skipsubj.sksb=forthline
            END
          ELSE
            DO
              SAY pen3'Skipping to the last message in the'def msg.msgdir pen3'conference.'def||CR
              lastread.msgdir=lstwrt-1
              lw=lstwrt-1
              msglist.lw=0
              msglist.lstwrt=1
              LEAVE mess
            END
        END
      ELSE IF msgcom='K' THEN
        DO
          IF level>sysoplevel | name=WORD(lynes.2,2) THEN
            DO
              IF getinput(1 1 'Really delete' arg'? (Ny) > ')='Y' THEN
                DO
                  IF DELETE(arg)=1 THEN
                    SAY pen3||arg||def' has been deleted.'CR
                  grand=grand-1
                  msg.msgdir.0=msg.msgdir.0-1
                END
            END
        END
      ELSE IF msgcom='O' THEN   /* go back and read original */
        DO
          IF WORDS(lynes.3)>3 THEN
            DO
              temp=WORD(lynes.3,4)
              arg=dirname'/'temp
            END
          ELSE SAY 'This is the original message.'CR
        END
      ELSE IF msgcom='R' THEN        /*  toname     msgnum  */
        DO
          msgnum=WORD(lynes.1,2)
          forthline=lynes.4
          IF editor('REPLY' WORD(lynes.2,2) msgnum) THEN /* reply */
            DO
              savearg2=arg
              arg=dirname'/'WORD(lynes.3,4)
              IF EXISTS(arg) THEN
                DO
                  IF readlines(arg 1) THEN BREAK
                  xmsg=countcheck(bbspath'Numbers/LastMessage'msgdir mess)
                  IF WORDS(lynes.1)>3 THEN lynes.1=lynes.1 xmsg
                  ELSE lynes.1=lynes.1'   Reply' xmsg
                  CALL DELAY(28)    /* allow 1/2 sec for read to close */
                  CALL savelines(arg)
                END
              arg=savearg2
            END
        END
      ELSE IF arg~=savearg THEN    /* Continue */
        DO
          msgcom='A'
          arg=savearg
        END
    END
    IF thread~='' THEN
      DO
        thread=''
        msgstatus=msgstatus+1
      END
  END
  IF msgstatus>1 THEN msgstatus=msgstatus-1
END
DROP msglist. skipsubj.
IF quietflag~=1 THEN nonstop=0
RETURN


showmarked:
ARG ff .
IF WORDS(data.24)<1 THEN RETURN
fline='These unread conference messages have been ['pen3'M'pen6']arked as addressed to you:'
IF ff THEN
  DO
    SAY CR
    SAY pen6||fline||def||CR
  END
tempkk=data.24
DO i=1 TO WORDS(tempkk)
  tempk=WORD(tempkk,i)
  PARSE VAR tempk kdir'/'kmsg
  line=RIGHT(kmsg,6) 'in the'pen3 msg.kdir def'conference'
  IF EXISTS(msgpath||tempk) THEN
    DO
      IF ff THEN SAY line'.'CR
      ELSE fline=fline'0A'x||line'.'
    END
  ELSE
    DO
      line=line 'is missing.'
      IF ff THEN SAY line||CR
      ELSE fline=fline'0A'x||line
      data.24=DELWORD(data.24,FIND(data.24,tempk),1)
    END
END
IF ff THEN
  DO
    CALL waiting()
    SAY CR
  END
ELSE
  DO
    IF writeopen(bbspath'EmailFiles/'name'/Marked')=0 THEN RETURN
    CALL WRITELN(f,fline)
    CALL CLOSE(f)
  END
RETURN


killmark:
PARSE ARG kdir kmsg .
IF data.24='' THEN RETURN
markword=FIND(data.24,kdir'/'kmsg)
IF markword>0 THEN data.24=STRIP(DELWORD(data.24,markword,1))
RETURN


readmarked:
mrknum=WORDS(data.24)
IF mrknum=0 THEN RETURN
SAY 'Reading only messages addressed to you...'CR
mrklist=data.24
msgcom=''
DO rmki=1 TO mrknum WHILE msgcom~='Q'
  tempk=WORD(mrklist,rmki)
  PARSE VAR tempk mkdir'/'mkmsg .
  IF ~EXISTS(msgpath||tempk) THEN
    DO
      CALL killmark(mkdir mkmsg)
      SAY CR
      SAY 'Message number' mkmsg 'in the' msg.mkdir 'conference is missing!'CR
      SAY CR
      ITERATE rmki
    END
  msgdir=mkdir
  savelast=lastread.msgdir
  CALL readmsg(1 mkmsg)
  IF mkmsg>savelast THEN lastread.msgdir=mkmsg
  ELSE lastread.msgdir=savelast
END
CALL saveData(1)
RETURN


sortnumbers:
PARSE ARG slist
IF STRIP(slist)='' THEN RETURN ''
sorted.=''
oldest=999999
newest=0
newlist=''
DO si=1 TO WORDS(slist)
  testword=WORD(slist,si)
  IF ~DATATYPE(testword,'W') THEN
    DO
      testpos=LASTPOS('.',testword)
      IF testpos>0 THEN tempnum=SUBSTR(testword,testpos+1)
      ELSE
        DO
          newlist=testword newlist
          ITERATE si
        END
    END
  ELSE tempnum=testword/1
  IF sorted.tempnum='' THEN
    DO
      sorted.tempnum=testword
      sorted.tempnum.0=1
      IF DATATYPE(tempnum,'W') THEN
        DO
          IF tempnum>newest THEN newest=tempnum
          IF tempnum<oldest THEN oldest=tempnum
        END
    END
  ELSE newlist=newlist testword
END
IF oldest~=999999 & newest~=0 THEN
  DO si=oldest TO newest
    IF sorted.si.0=1 THEN newlist=newlist sorted.si
  END
DROP sorted. oldest newest
RETURN STRIP(newlist)


readmail:
ARG fromenu .
CALL postuser(3)
replysubj=''
IF fromenu THEN
  DO
    temp=UPPER(arg)
    arg=''
    IF temp~='F' & temp~='T' & temp~='W' THEN
      DO
        line='Find Email ['pen3'F'def']rom You ['pen3'T'def']o You or ['pen3'W'def']rite New Email (ftw) > 'def
        temp=getinput(1 1 line)
        CALL cleanline(0)
      END
    IF temp='W' THEN
      DO
        CALL editor('MAIL')
        RETURN
      END
    ELSE IF temp='F' THEN
      DO
        firsteditline=0
        picklist.=''
        picklist.0=0
        IF getinput(1 1 'Check ALL users? (nY) > ')='N' THEN
          DO
            picklist.1=getinput(1 0 'Check EMail From' name 'To Who? > ')
            picklist.1=SPACE(STRIP(UPPER(picklist.1)),1,'_')
            picklist.1=COMPRESS(picklist.1,'.,:/*#?^ ')
            IF picklist.1='' THEN RETURN
            IF FIND(userlist,picklist.1)=0 THEN
              DO
                SAY '***'pen3 picklist.1 def'does not exist!'||CR
                picklist.0=0
                RETURN
              END
            fmaillist=SHOWDIR(bbspath'EMail/'picklist.1)
            DO ej=1 TO WORDS(fmaillist)
              ejname=WORD(fmaillist,ej)
              uname=ejname
              caret=LASTPOS('.',uname)
              IF caret>2 THEN uname=LEFT(uname,caret-1)
              IF uname=name THEN
                DO
                  arg=bbspath'EMail/'picklist.1'/'ejname
                  IF EXISTS(arg) THEN
                    DO
                      pklst=picklist.0+1
                      picklist.pklst=picklist.1
                      picklist.pklst.0=ejname
                      picklist.0=pklst
                    END
                END
            END
            IF picklist.0=0 THEN SAY 'No Email FROM you was found.'||CR
            ELSE
              DO
                SAY pen3'You have the following Email pending:'def||CR
                pickcheck=1
                DO WHILE pickcheck~=0
                  pickcheck=pickfromlist()
                  IF pickcheck~=0 THEN
                    DO
                      firsteditline=5
                      IF level>sysoplevel THEN firsteditline=1
                      CALL bbsED(firsteditline bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0)
                      IF ~EXISTS(bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0) THEN
                        picklist.pickcheck='- KILLED -'
                    END
                END
              END
          END
        ELSE
          DO
            users=WORDS(userlist)
            SAY pen3'Scanning'def users pen3'email directories...'def||CR
            SAY pen3' - To ABORT, press CTRL-E -'def||CR
            DO wi=1 TO users
              CALL busywait(60 wi users)
              fmaillist=SHOWDIR(bbspath'EMail/'WORD(userlist,wi))
              DO ej=1 TO WORDS(fmaillist)
                ejname=WORD(fmaillist,ej)
                uname=ejname
                caret=LASTPOS('.',uname)
                IF caret>2 THEN uname=LEFT(uname,caret-1)
                IF uname=name THEN
                  DO
                    arg=bbspath'EMail/'WORD(userlist,wi)'/'ejname
                    IF EXISTS(arg) THEN
                      DO
                        pklst=picklist.0+1
                        picklist.pklst=WORD(userlist,wi)
                        picklist.pklst.0=ejname
                        picklist.0=pklst
                      END
                  END
              END
              IF wi=999999 THEN RETURN
            END
            CALL busywait(4 0)
            IF picklist.0=0 THEN SAY lineup'No Email FROM you was found.                  'CR
            ELSE
              DO
                SAY pen3'You have Email pending to the following users:'def||CR
                pickcheck=1
                DO WHILE pickcheck~=0
                  pickcheck=pickfromlist()
                  IF pickcheck~=0 THEN
                    DO
                      firsteditline=5
                      IF level>sysoplevel THEN firsteditline=1
                      CALL bbsED(firsteditline bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0)
                      IF ~EXISTS(bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0) THEN
                        picklist.pickcheck='- KILLED -'
                    END
                END
              END
          END
        DROP picklist.
        RETURN
      END
    ELSE IF temp='T' THEN BREAK
    ELSE RETURN
  END
SAY 'Checking your mailbox...'CR
nomail=1
CALL MAKEDIR(bbspath'EMail/'name)
mailist=sortnumbers(SHOWDIR(bbspath'Email/'name))
IF WORDS(mailist)=0 THEN
  DO
    SAY lineup'Your mailbox is empty.  'CR
    SAY CR
    RETURN
  END
line=WORDS(mailist)
IF line>1 THEN line=line 'letters'
ELSE line=line 'letter'
line=line 'waiting.'
SAY line||CR
DO ii=1 TO WORDS(mailist)
  SAY 'Email:' pen3||WORD(mailist,ii)||def||CR
END
IF ~fromenu THEN
  IF getinput(1 1 'Read your private mail now? (nY) > ')='N' THEN RETURN
onename=''
IF WORDS(mailist)>3 THEN
  DO
    IF getinput(1 1 'Read all private mail? (nY) > ')='N' THEN
      DO
        onename=getinput(1 0 'Read ONLY private mail from? > ')
        onename=SPACE(STRIP(UPPER(onename)),1,'_')
        onename=COMPRESS(onename,'.,:/*#?^ ')
        IF onename='' THEN RETURN
        IF FIND(userlist,onename)=0 & picklist.1~='BBBBS' THEN
          DO
            SAY '***'pen3 onename def'does not exist!'||CR
            RETURN
          END
      END
  END
DO letter=1 TO WORDS(mailist)
  readname=WORD(mailist,letter)
  uname=readname
  caret=LASTPOS('.',uname)
  IF caret>2 THEN uname=LEFT(uname,caret-1)
  IF onename~='' & onename~=uname THEN ITERATE letter
  arg=bbspath'Email/'name'/'readname        /* user has mail! */
  CALL readlines(arg 1)
  delnum=WORD(lynes.1,2)
  CALL seelines(1)
  nomail=0
  nonstop=0
  mailfile=''
  IF UPPER(WORD(lynes.1,3))='FILE:' THEN mailfile=WORD(lynes.1,4)
  ELSE IF UPPER(WORD(lynes.2,3))='FILE:' THEN mailfile=WORD(lynes.2,4)
  IF mailfile~='' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & LEFT(readname,3)~='MSG' THEN
    DO
      IF LEFT(RIGHT(mailfile,4),1)~='.' & LEFT(readname,6)='BBBBS.' THEN
        DO
          SAY CR
          SAY pen3'The attached file is unarchived and may be incomplete.'CR
          SAY 'If the archiver is still building this file, downloading will fail.'def||CR
          IF getinput(1 1 'Do you want to try to download it anyway? (Ny) > ')~='Y' THEN ITERATE letter
          SAY CR
        END
      curdir=PRAGMA('D')
      CALL setdir(bbspath'EmailFiles/'name)
      filesize=WORD(STATEF(mailfile),2)
      IF getinput(1 1 ' Attached file:' pen3||mailfile||def 'is' pen3||filesize||def 'bytes.  Download now? (nY) > ')~='N' THEN
        DO
          savearg=arg
          allargs=bbspath'EmailFiles/'name'/'mailfile
          DO WHILE dload2()=1
          END
          arg=savearg
          CALL readlines(arg 1)
        END
      CALL setdir(curdir)
    END
  IF readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & LEFT(readname,3)~='MSG' & LEFT(readname,6)~='BBBBS.' THEN
    DO
      tempchar='A'
      DO WHILE tempchar='A'
        tempchar=getinput(1 1 '['pen3'A'def']gain  ['pen3'C'def']ontinue  ['pen3'R'def']eply (acR) > ')
        IF tempchar='' THEN tempchar='R'
        IF tempchar='A' THEN CALL seelines(1)
      END
      IF tempchar='R' THEN
        DO
          IF WORDS(lynes.4)<2 THEN replysubj='NONE'
          ELSE replysubj=SUBSTR(lynes.4,WORDINDEX(lynes.4,2))
          CALL editor('MAIL' uname)
          replysubj=''
        END
    END
  IF LEFT(readname,6)~='BBBBS.' THEN
    DO
      tempchar='A'
      DO WHILE tempchar='A'
        tempchar=getinput(1 1 'Forward mail from'pen3 uname def'to other users? (aNy) > ')
        IF tempchar='A' THEN CALL seelines(1)
      END
      IF tempchar='Y' THEN
        DO
          IF selectchosen(1 pen3'Forward Email To: 'def)=0 THEN
            DO ei=1 TO thechosen.0 WHILE thechosen.ei~=''
              CALL MAKEDIR(bbspath'EMail/'thechosen.ei)
              forwardarg=bbspath'Email/'thechosen.ei'/'readname
              ADDRESS COMMAND 'C:COPY' bbspath'Email/'name'/'readname forwardarg
              CALL readlines(forwardarg 1)
              lynes.1=lynes.1'  Forwarded to you by' name TIME('C') DATE()
              CALL DELETE(forwardarg)
              CALL savelines(forwardarg)
              IF WORDS(lynes.2)>3 THEN
                DO
                  forname=bbspath'EmailFiles/'name'/'WORD(lynes.2,4)
                  IF EXISTS(forname) THEN
                    DO
                      CALL MAKEDIR(bbspath'EmailFiles/'thechosen.ei)
                      ADDRESS COMMAND 'C:COPY' forname bbspath'EmailFiles/'thechosen.ei
                    END
                END
              line='Mail' pen3||readname||def 'forwarded to' pen3||thechosen.ei||def
              IF emailonline>=0 THEN emailonline=emailonline+1
              CALL send2log(line)
              SAY line||CR
            END
        END
    END
  tempchar=''
  tempstr='Delete the email ('pen3||delnum||def') from'pen3 uname def'that you just read?'
  IF mailfile='' THEN tempchar=getinput(1 1 tempstr '(nqY) > ')
  ELSE
    DO WHILE tempchar~='N' & tempchar~='Q' & tempchar~='Y'
      tempchar=getinput(1 1 tempstr '(nqy) > ')
    END
  IF tempchar='Q' THEN
    DO
      IF getinput(1 1 'Quit reading your Email? (Ny) > ')='Y' THEN
        DO
          readname=''
          uname=''
          RETURN
        END
    END
  ELSE IF tempchar~='N' THEN
    DO
      dirname=bbspath'Email/'name'/'
      nodelete=0
      IF bbsprefs.14=1 & name~=sysop & uname~=sysop & WORD(lynes.2,2)~='BBBBS' & WORD(lynes.2,2)~=sysop & WORD(lynes.3,2)~=sysop THEN
        nodelete=1
      IF nodelete THEN
        ADDRESS COMMAND 'C:Copy' dirname||readname bbspath'Email/'sysop
      ELSE emailonline=emailonline-1
      CALL DELETE(dirname||readname)
      tempstr='Old email'
      IF mailfile~='' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & EXISTS(bbspath'EmailFiles/'name'/'mailfile) THEN
        DO
          IF nodelete THEN
            ADDRESS COMMAND 'C:Copy' bbspath'EmailFiles/'name'/'mailfile bbspath'EmailFiles/'sysop
          CALL DELETE(bbspath'EmailFiles/'name'/'mailfile)
          CALL DELETE(bbspath'EmailFiles/'name'/'mailfile'.xdl')
          tempstr=tempstr 'and attached file'
        END
      tempstr=tempstr 'deleted. Thank you for keeping a clean BBS!'
      SAY tempstr||CR
      IF tempchar='Q' THEN
        IF getinput(1 1 'Quit reading your Email? (Ny) > ')='Y' THEN
          DO
            readname=''
            uname=''
            RETURN
          END
    END
  ELSE IF LEFT(readname,3)='MSG' & level>sysoplevel THEN
    DO
      ii=LEFT(readname,POS('.',readname)-1)
      ii=SUBSTR(ii,4)%1
      IF getinput(1 1 'Move this message back to the' msg.ii 'conference? (nY) > 'def)~='N' THEN
        DO
          temp=TRANSLATE(readname,'/','.')
          temp=SUBSTR(temp,4)
          lynes.1='!!'STRIP(lynes.1)
          edtype=''
          CALL savelines(msgpath||temp)
          CALL DELETE(bbspath'Email/'name'/'readname)
        END
    END
  ELSE IF LEFT(readname,3)~='MSG' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' THEN
    DO
      arg=bbspath'Email/'name'/'readname
      CALL readlines(arg 1)
      IF WORDS(lynes.5)<7 THEN
        DO
          lynes.5=lynes.5'  (Rcvd)' DATE('W') DATE() TIME('C')
          CALL DELETE(arg)
          CALL savelines(arg)
          SAY 'Email has been marked as received.'CR
        END
    END
  CALL checktime()
  readname=''
  uname=''
  arg=''
END
IF nomail THEN
  DO
    SAY 'No mail was found.'CR
    CALL waiting()
  END
CALL setdir(libpath||dirs.1)
thechosen.=''
RETURN


selectchosen:
PARSE ARG startat selectline
IF startat<2 THEN thechosen.=''
line='Enter list of comma separated user names'
IF level>sysoplevel THEN line=line 'or ALL'
SAY line||CR
thechosen.startat=getinput(1 0 selectline' ')
IF STRIP(thechosen.startat)='' THEN RETURN 1
thechosen.startat=SPACE(thechosen.startat,1,'_')
thechosen.0=startat
IF level>sysoplevel & thechosen.startat='ALL' THEN
  thechosen.startat=SHOWDIR(bbspath'Users','F',',')
IF POS(',',thechosen.startat)>0 THEN
  DO
    temp=TRANSLATE(thechosen.startat,' ',',')
    thechosen.0=thechosen.0+WORDS(temp)-1
    DO ei=1 TO WORDS(temp)
      eii=startat+ei-1
      thechosen.eii=STRIP(WORD(temp,ei))
    END
  END
DO ei=startat TO thechosen.0
  DO WHILE FIND(userlist,thechosen.ei)=0
    IF thechosen.ei~='' THEN
      DO
        IF FIND(exclusion,thechosen.ei)>0 | thechosen.ei='BBBBS' THEN
          DO
            thechosen.ei=sysop
            ITERATE ei
          END
        CALL loadcourtesy()
        IF FIND(courtesy,thechosen.ei)>0 THEN ITERATE ei
      END
    SAY thechosen.ei 'not found! Enter that name again or press RETURN.'CR
    thechosen.ei=getinput(1 0 pen3||selectline' 'def)
    IF thechosen.ei='' THEN
      DO
        IF getinput(1 1 'Do you want to see the list of current users? (Ny) > ')='Y' THEN
          CALL showuserlist()
        ITERATE ei
      END
    thechosen.ei=SPACE(thechosen.ei,1,'_')
  END
END
RETURN 0


countcheck:
PARSE ARG fname' 'cknum' '.
IF ~EXISTS(fname) THEN
  DO
    IF cknum=0 THEN RETURN 0
    IF ~writeopen(fname) THEN RETURN 0
    CALL WRITELN(f,cknum)
    CALL CLOSE(f)
    RETURN cknum
  END
IF ~readopen(fname) THEN RETURN cknum
retval=STRIP(READLN(f))
CALL CLOSE(f)
IF ~DATATYPE(retval,'W') THEN retval=0
IF ~DATATYPE(cknum,'W') THEN cknum=0
IF retval<cknum THEN
  DO
    IF writeopen(fname) THEN
      DO
        CALL WRITELN(f,cknum)
        CALL CLOSE(f)
        RETURN cknum
      END
  END
RETURN retval


pickfromlist:
DO pfl=1 TO picklist.0 BY 3
  pfl2=pfl+1
  pfl3=pfl+2
  pfline=pen3||RIGHT(pfl,3)||def LEFT(picklist.pfl,21)
  IF picklist.pfl2~='' THEN
    pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(picklist.pfl2,21)
  IF picklist.pfl3~='' THEN
    pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(picklist.pfl3,21)
  SAY pfline||CR
END
emnum=getinput(1 0 pen3'Select Email Number > 'def)
IF ~DATATYPE(emnum,'W') | emnum<1 | emnum>picklist.0 THEN RETURN 0
RETURN emnum


sysED:
IF level<99 THEN RETURN
arg=getinput(0 0 'Textfile To Edit: ')
IF arg='' THEN RETURN
CALL bbsED(1 arg)
RETURN


bbsED:
PARSE ARG firstedit editarg .
notchanged=1
IF readlines(editarg 1) THEN RETURN 1
finfo=STATEF(editarg)
IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8))
ELSE finfo=''
SAY CR
SAY '                   'pen3'Entering the EDITOR module..'def||CR
SAY CR
count=1
DO edloop=1
  IF edcom='S' & bbsprefs.5 THEN  /* spell check */
    DO
      SAY pen3'You must use ['def'R'pen3']eplace to make corrections.  'pen2'Spellchecking...'def||CR
      CALL DELETE(scratch'/SpellFile')
      CALL savelines(scratch'/SpellFile')
      curdir=PRAGMA('D')
      CALL setdir(spellpath)
      CALL SpellChk.rexx(scratch'/SpellFile')
      CALL setdir(curdir)
    END
  ELSE
    DO
      IF edcom='R' | edcom='I' | edcom='L' THEN CALL wrapbuf(7)
      IF edcom~='L' THEN count=count-linesperpage
      IF count>=lynes.0 | count<1 THEN count=1
      startcount=count
      DO i=startcount TO lynes.0+1
        IF ((i+1-startcount)//linesperpage)=0 THEN
          DO
            pline='                 ['pen3'E'def']dit'
            pline=pline '  ['pen3'RETURN'def']=Continue '
            edcom=getinput(1 1 pline)
            IF edcom~='' THEN LEAVE i
            CALL cleanline(1)
          END
        SAY pen3||RIGHT(i,3)||def lynes.i||CR
        count=count+1
      END
    END
  CALL checktime()
  SAY lineup'     ['pen3'A'def']ppend ['pen3'C'def']ut     ['pen3'I'def']nsert  ['pen3'K'def']ill       ['pen3'?'def'] Help'CR
  pline='     ['pen3'L'def']ist   ['pen3'P'def']aste   ['pen3'R'def']eplace'
  IF bbsprefs.5 THEN pline=pline '['pen3'S'def']pellcheck'
  pline=pline '['pen3'U'def']pload-Text > '
  edcom=getinput(1 0 pline)
  IF edcom='Q' | edcom='X' THEN edcom=''
  IF edcom='?' THEN
    DO
      SAY CR
      SAY '                   Editor Help'CR
      SAY '----------------------------------------------------------'CR
      SAY '    an empty RETURN tells the editor you are done editing.'CR
      SAY ' 7  edits line number 7, if it exists.'CR
      SAY ' a  Append text to this file.'CR
      SAY ' c  Cut selected line(s) of text to buffer.'CR
      SAY ' i  Insert blank line.'CR
      SAY ' k  Kill (delete) this file.'CR
      SAY ' l  List this file from selected line.'CR
      SAY ' p  Paste buffer contents to selected line number.'CR
      SAY ' r  Replace a phrase or line of text.'CR
      SAY ' s  Spellcheck this file.'CR
      SAY ' u  Upload a textfile to append to this file.'CR
      SAY '----------------------------------------------------------'CR
      SAY CR
      OPTIONS PROMPT ''
      PULL
    END
  IF edcom='K' THEN
    DO
      junk=getinput(1 1 'Are you' pen3'sure'def 'you want to delete' editarg'? (Ny) > ')
      IF junk='Y' THEN
        DO
          IF DELETE(editarg)=1 THEN SAY editarg 'DELETED.'CR
          IF WORD(lynes.1,1)='Mail:' & WORDS(lynes.2)>3 THEN
            DO
              IF DELETE(bbspath'EmailFiles/'WORD(lynes.3,2)'/'WORD(lynes.2,4))=1 THEN
                SAY WORD(lynes.2,4) 'DELETED.'CR
            END
          RETURN 2
        END
    END
  IF edcom='' THEN
    DO
      SAY '                   'pen3'Leaving the EDITOR module.'def||CR
      IF notchanged THEN RETURN 0
      IF getinput(1 1 '                     Save changes? (nY)'pen3' > 'def)='N' THEN
        RETURN 1
      CALL DELETE(editarg)
      IF savelines(editarg) THEN RETURN 1
      CALL DELAY(28)
      IF finfo~='' THEN ADDRESS COMMAND 'C:filenote' editarg finfo
      SAY pen3'                        Changes saved.'def||CR
      RETURN 0
    END
  ELSE IF edcom='C' THEN  /* Cut */
    DO
      firstnum=getinput(1 0 '   Enter line number or range 'pen3'(5-7)'def' to cut' pen3'>'def)
      IF firstnum='' THEN ITERATE edloop
      dash=POS('-',firstnum)
      IF dash>0 THEN
        DO
          lastnum=STRIP(SUBSTR(firstnum,dash+1))
          firstnum=STRIP(LEFT(firstnum,dash-1))
        END
      ELSE lastnum=firstnum
      IF ~DATATYPE(firstnum,'W') | ~DATATYPE(lastnum,'W') THEN
        DO
          junk=getinput(1 1 pen3'*** You must enter numbers here! 'def)
          ITERATE edloop
        END
      IF lastnum>lynes.0 THEN lastnum=lynes.0
      IF firstnum<firstedit THEN
        DO
          SAY '*** You are not authorized to delete that line!'CR
          SAY CR
          ITERATE edloop
        END
      IF firstnum>lastnum THEN
        DO
          SAY '*** Input error!  First number larger than last number.'CR
          ITERATE edloop
        END
      notchanged=0
      numdiff=lastnum+1-firstnum
      pasted.=''
      pasted.0=numdiff
      k=0
      DO i=firstnum TO lynes.0
        j=i+numdiff
        k=k+1
        IF k<=numdiff THEN pasted.k=lynes.i
        lynes.i=lynes.j
        lynes.j=''
      END
      lynes.0=lynes.0-numdiff
      count=1
    END
  ELSE IF edcom='A' THEN  /* append */
    DO
      CALL writebuffer(scratch'/EditorFile')
      notchanged=0
    END
  ELSE IF edcom='U' THEN  /* Upload a textfile to append */
    DO
      CALL txup(1)
      notchanged=0
    END
  ELSE IF edcom='I' | edcom='R' | edcom='L' | edcom='P' | DATATYPE(edcom,'W') THEN
    DO
      IF DATATYPE(edcom,'W') THEN
        DO
          ednum=edcom
          edcom='R'
        END
      ELSE
        DO
          line=pen3'   '
          IF edcom='L' | edcom='P' THEN line=line'Starting '
          line=line'Line Number? > 'def
          ednum=getinput(1 0 line)
        END
      IF ~DATATYPE(ednum,'W') THEN ITERATE edloop
      IF ednum>(lynes.0+1) THEN ITERATE edloop
      IF edcom='L' THEN
        DO
          count=ednum
          ITERATE edloop
        END
      IF ednum=1 & UPPER(WORD(lynes.1,1))='FILE:' THEN
        DO
          IF getinput(1 1 pen3'Edit KeyWords:? (Ny) > 'def)='Y' THEN
            DO
              filenum=STRIP(WORD(lynes.1,2))
              num=files.filenum.0
              keywords=edkeywords(editarg)
              lynes.1=LEFT(lynes.1,21) keywords
              alpha.num=TRIM(OVERLAY(keywords,alpha.num,47,32))
              savefileflag=1
              notchanged=0
              ITERATE edloop
            END
        END
      IF ednum<firstedit THEN
        DO
          SAY '*** You are not authorized to alter that line!'CR
          SAY CR
          ITERATE edloop
        END
      IF edcom='R' THEN   /* replace */
        DO
          SAY '   Now reads:'CR
          SAY pen3||RIGHT(ednum,2)||def lynes.ednum||CR
          OPTIONS PROMPT pen3'........Search text? >'def
          PARSE PULL stext
          IF LENGTH(stext)=0 THEN
            DO
              IF getinput(1 1 lineup||pen3'Replace entire line? (nY) >'def)='N' THEN
                ITERATE edloop
              lynes.ednum=getinput(0 0 pen3||RIGHT(ednum,2)' 'def)
              notchanged=0
              ITERATE edloop
            END
          found=POS(UPPER(stext),UPPER(lynes.ednum))
          IF found=0 THEN
            DO
              SAY CR
              SAY stext' was not found!'CR
              SAY CR
              ITERATE edloop
            END
          OPTIONS PROMPT pen3'...Replacement text? >'def
          PARSE PULL rtext
          lynes.ednum=DELSTR(lynes.ednum,found,LENGTH(stext))
          lynes.ednum=INSERT(rtext,lynes.ednum,found-1)
          IF ednum<4 & LEFT(lynes.1,6)='File: ' THEN
            DO
              PARSE VAR lynes.1 'File: 'filenum . 'KeyWords: 'keywords
              PARSE VAR lynes.3 . 'Lib:' libnam
              filenum=STRIP(filenum)
              newc=files.filenum.0
              libnum=finddirnum(libnam)
              alpha.newc=LEFT(WORD(lynes.2,2),22-LENGTH(WORD(lynes.2,4)))
              alpha.newc=alpha.newc WORD(lynes.2,4) RIGHT(filenum,5)
              alpha.newc=alpha.newc RIGHT(libnum,2) LEFT(STRIP(libnam),12)
              alpha.newc=alpha.newc STRIP(LEFT(STRIP(keywords),32))
              savefileflag=1
            END
          SAY 'Done.'CR
          SAY CR
          notchanged=0
        END
      ELSE IF edcom='I' THEN  /* insert */
        DO
          DO i=lynes.0 TO ednum BY -1
            j=i+1
            lynes.j=lynes.i
          END
          lynes.ednum=''
          notchanged=0
          lynes.0=lynes.0+1
          lynes.ednum=getinput(0 0 pen3||RIGHT(ednum,2)'>'def)
        END
      ELSE IF edcom='P' THEN   /* paste */
        DO
          DO i=lynes.0 TO ednum BY -1
            j=i+pasted.0
            lynes.j=lynes.i
          END
          DO k=1 TO pasted.0
            kk=ednum+k-1
            lynes.kk=pasted.k
          END
          notchanged=0
          lynes.0=lynes.0+pasted.0
        END
    END
END
RETURN 0


editor:
toname=''
msgnum=0
thechosen.=''
PARSE ARG edtype toname msgnum .
IF edtype='MAIL' THEN lastwrit=countcheck(bbspath'Numbers/LastMail 0')
ELSE
  DO
    IF edtype='MSG' THEN
      DO
        tempmsgdir=0
        IF DATATYPE(arg,'W') THEN tempmsgdir=arg
        IF tempmsgdir>0 & tempmsgdir<=level & msg.tempmsgdir~='' THEN
          msgdir=tempmsgdir
        ELSE IF areaselect() THEN RETURN
      END
    lastwrit=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
  END
IF toname='' THEN
  DO
    IF edtype='MAIL' THEN
      DO
        CALL selectchosen(1 pen3'Send PRIVATE' edtype lastwrit+1 'To: 'def)
        toname=thechosen.1
      END
    ELSE toname=getinput(1 0 pen3'Post A PUBLIC Message To: 'def)
  END
toname=SPACE(toname,1,'_')
toname=cleanstring(1':'toname)
IF toname='' | FIND(exclusion,toname)>0 THEN
  DO
    IF toname='' & edtype='MSG' THEN toname='ALL'
    ELSE toname=sysop
    SAY pen3'*** Re-Addressed to'def toname||CR
  END
IF toname~='ALL' THEN
  DO
    IF toname='BBBBS' THEN toname=sysop
    IF FIND(userlist,toname)=0 THEN
      DO
        IF courtesy='' THEN CALL loadcourtesy()
        IF FIND(courtesy,toname)=0 THEN
          DO
            SAY CR
            SAY bak2' 'toname' is not on the user list! 'def||CR
            IF edtype='MAIL' THEN
              DO
                CALL showuserlist()
                RETURN 0
              END
            ELSE
              DO
                IF getinput(1 1 'Do you want to use it anyway? (nY) > ')='N' THEN
                  DO
                    IF getinput(1 1 'Do you want to see the list of current users? (Ny) > ')='Y' THEN
                      CALL showuserlist()
                    RETURN 0
                  END
              END
          END
      END
  END
IF toname=sysop THEN CALL sound('FEEDBACK')
ELSE CALL sound('MESSAGE')
IF edtype='MAIL' THEN
  DO
    CALL MAKEDIR(bbspath'EMail/'toname)
    mailname=bbspath'EMail/'toname'/'name'.'lastwrit+1
  END
ELSE
  DO
    CALL MAKEDIR(msgpath||msgdir)
    mailname=msgpath||msgdir'/'lastwrit+1
  END
lynes.=''
lynes.0=6
IF edtype='MAIL' THEN lynes.1=' Mail:' lastwrit+1  /* FILE: filename */
ELSE lynes.1='  Msg:' lastwrit+1          /* Msg: MSG# REPLY # # ... */
lynes.2=' From:' name
IF city~='' THEN lynes.2=lynes.2' - 'city
lynes.3='   To:' toname                       /*  To: toname   MSG # */
IF edtype='MAIL' THEN
  DO
    IF readopen(bbspath||'Users/'toname) THEN
      DO
        CALL READLN(f)
        CALL READLN(f)
        temp=READLN(f)
        CALL CLOSE(f)
        temp=docity(temp)
        IF temp~='' THEN lynes.3=lynes.3' - 'temp
      END
    IF replysubj='|@NEW@|' THEN
      DO
        CALL readlines(bbspath'BBS_TEXT/EMAIL_WELCOME' 7)
        replysubj='Welcome to' bbsname
      END
  END
subj=''
IF edtype='REPLY' THEN
  DO
    subj=SUBSTR(forthline,WORDINDEX(forthline,2))
    SAY pen3'Subj:'def subj||CR
    temp=getinput(0 0 'Change the current subject? (Ny) > ')
    IF LENGTH(temp)>3 THEN subj=temp
    ELSE IF LEFT(UPPER(temp),1)='Y' THEN subj=''
  END
ELSE IF edtype='MAIL' & replysubj~='' THEN subj=replysubj
IF subj='' THEN
  DO
    IF opt='C' THEN subj='FEEDBACK'
    ELSE
      DO
        SAY pen3'Enter the'def 'Subject' pen3'of this message (1 line).'def||CR
        subj=getinput(0 0 pen3': 'def)
      END
  END
IF LENGTH(subj)>66 THEN subj=LEFT(subj,66)
IF subj='' THEN subj='?'
lynes.4=' Subj:' subj
lynes.5=' Date:' DATE('W') DATE()'  'TIME('C')
IF edtype~='MAIL' THEN lynes.5=LEFT(lynes.5,39) 'Conference:' msg.msgdir
lynes.6=LEFT('',74,'=')
IF edtype='REPLY' THEN lynes.3=lynes.3'  MSG 'msgnum
DO i=1 TO lynes.0
  SAY lynes.i||CR
END
CALL writebuffer(scratch'/MessageFile')
IF savelines(mailname) THEN RETURN 0
CALL seelines(1)
IF thechosen.0='' THEN
  DO
    thechosen.0=1
    thechosen.1=toname
  END
carbons=thechosen.0+1
DO FOREVER
  IF thechosen.0>=carbons THEN
    DO
      junk='Copies To:'
      DO cci=carbons TO thechosen.0
        junk=junk thechosen.cci
      END
      SAY junk||CR
    END
  pline=''
  IF edtype='MAIL' THEN pline='['pen3'C'def']opies'
  pline=STRIP(pline '['pen3'E'def']dit ['pen3'K'def']ill ['pen3'R'def']ead')
  pline=pline '['pen3'U'def']pload-Text ['pen3'S'def']end' edtype'? (ekrSu) 'def
  junk=getinput(1 1 pline)
  IF junk='E' THEN
    DO
      IF level>sysoplevel THEN firstedit=1
      ELSE firstedit=7
      IF bbsED(firstedit mailname)=2 THEN RETURN 0
      junk='R'
    END
  ELSE IF edtype='MAIL' & junk='C' THEN
    DO
      CALL selectchosen(carbons pen3'Carbon Copies To: 'def)
      junk='R'
    END
  ELSE IF junk='K' THEN
    DO
      IF DELETE(mailname)=1 THEN SAY edtype 'DELETED.'CR
      RETURN 0
    END
  ELSE IF junk='U' THEN
    DO
      CALL txup(0 mailname)
      junk='R'
    END
  IF junk='R' THEN
    DO
      CALL readlines(mailname 1)
      CALL seelines(1)
      nonstop=0
    END
  ELSE BREAK
END
IF edtype='MAIL' THEN
  DO
    IF replysubj~='' & readname~='' & LEFT(readname,5)~='BBBBS' & uname~='' & uname~='UNAME' THEN
      DO
        junk=getinput(1 1 'Attach original mail from' uname'? (nY) > ')
        IF junk~='N' THEN
          DO
            arg=bbspath'Email/'name'/'readname
            IF ~readlines(arg 1) THEN CALL savelines(mailname)
          END
      END
    junk=getinput(1 1 pen3'Attach a file to this message? (Ny) > 'def)
    IF junk='Y' THEN
      DO
        savearg=arg
        arg=getinput(0 0 'Filename: ')
        curdir=PRAGMA('D')
        CALL MAKEDIR(bbspath'EmailFiles/'toname)
        CALL setdir(bbspath'EmailFiles/'toname)
        DO WHILE uload(0)=2
        END
        IF WORD(STATEF(bbspath'EmailFiles/'toname'/'arg),2)>1 THEN
          DO
            CALL readlines(mailname 1)
            IF arg~='' THEN lynes.1=lynes.1'  FILE: 'arg
            CALL setdir(curdir)
            CALL DELETE(mailname)
            CALL savelines(mailname)
          END
        ELSE
          DO
            CALL DELETE(bbspath'EmailFiles/'toname'/'arg)
            SAY pen3'*** Upload failed! ***'def||CR
          END
        arg=savearg
      END
    totmail=WORD(data.17,2)
    IF ~DATATYPE(totmail,'W') THEN totmail=1
    ELSE totmail=totmail+1
    data.17=WORD(data.17,1)'  'totmail'  'WORD(data.17,3)
  END
IF edtype~='MAIL' THEN totwrit.msgdir=totwrit.msgdir+1
CALL readlines(mailname 1)
DO ui=1 TO thechosen.0
  IF thechosen.ui='' THEN ITERATE ui
  IF ui>1 THEN
    DO
      CALL MAKEDIR(bbspath'Email/'thechosen.ui)
      newname=bbspath'Email/'thechosen.ui'/'name'.'lastwrit+1
      IF ui<carbons THEN lynes.3='   To:' thechosen.ui
      ELSE
        DO
          lynes.1=lynes.1'  (Carbon Copy)'
          lynes.3='   To:' thechosen.1
        END
      CALL savelines(newname)
      IF WORDS(lynes.1)>3 & EXISTS(bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.1,4)) THEN
        DO
          CALL MAKEDIR(bbspath'EmailFiles/'thechosen.ui)
          ADDRESS COMMAND 'C:COPY' bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.1,4) bbspath'EmailFiles/'thechosen.ui
          line2='Copied' WORD(lynes.1,4)
          SAY line2 'to the' thechosen.ui 'file area.'CR
          CALL send2log(line2)
        END
    END
  line=edtype':'lastwrit+1 'at' TIME('C') 'to' thechosen.ui
  IF edtype~='MAIL' THEN
    DO
      IF FIND(userlist,thechosen.ui)>0 THEN
        CALL msgmark(thechosen.ui msgdir lastwrit+1)
      line=line 'in' msg.msgdir
    END
  CALL send2log(line)
  line=edtype 'Sent To' thechosen.ui
  IF edtype='MAIL' THEN
    DO
      IF emailonline>=0 THEN emailonline=emailonline+1
    END
  ELSE
    DO
      grand=grand+1
      IF ~DATATYPE(msg.msgdir.0,'W') THEN msg.msgdir.0=1
      ELSE msg.msgdir.0=msg.msgdir.0+1
      line=line 'in the'pen3 msg.msgdir def'conference.'
    END
  SAY line||CR
END
IF edtype='MAIL' THEN CALL countcheck(bbspath'Numbers/LastMail' lastwrit+1)
ELSE CALL countcheck(bbspath'Numbers/LastMessage'msgdir lastwrit+1)
CALL setdir(libpath||dirs.1)
thechosen.=''
RETURN 1


txup:
PARSE ARG upflg uparg .
SAY 'Ready to append' pen3'TEXT ONLY'def 'using'pen3 protocol||def||CR
pline='Are you SURE your file is un-compressed text? (Ny) > '
IF getinput(1 1 pline)='Y' THEN
  DO
    savearg=arg
    arg='UploadFile'
    curdir=PRAGMA('D')
    CALL setdir(scratch)
    CALL DELETE(arg)
    CALL DELETE('tempfile1')
    IF uload(0)=0 THEN
      DO
        IF upflg=0 THEN
          DO
            ADDRESS COMMAND 'C:copy' uparg 'tempfile1'
            CALL DELETE(uparg)
            ADDRESS COMMAND 'C:join tempfile1 UploadFile AS' uparg
          END
        ELSE IF upflg=1 THEN
          DO
            CALL readlines(arg lynes.0+1)
            notchanged=0
          END
      END
    CALL setdir(curdir)
    arg=savearg
  END
RETURN


msgmark:
PARSE ARG markname markdir markmsg .
IF OPEN(f,bbspath'Users/'markname,'R')=0 THEN RETURN
mlines.=''
DO mi=1
  temp=READLN(f)
  IF EOF(f) THEN LEAVE mi
  mlines.mi=STRIP(temp)
END
CALL CLOSE(f)
mlines.0=mi-1
CALL DELAY(28)
mlines.24=STRIP(mlines.24 markdir'/'markmsg)
IF OPEN(f,bbspath'Users/'markname,'W')=0 THEN RETURN
DO mi=1 TO mlines.0
  CALL WRITELN(f,mlines.mi)
END
CALL CLOSE(f)
RETURN


shell:
SAY CR
olddir=PRAGMA('D')
DO WHILE(UPPER(opt)~='EXIT')
  SAY bak2||TIME('C')||def PRAGMA('D')||CR
  OPTIONS PROMPT pen3'Type EXIT to quit AmigaDOS> 'def
  PARSE PULL opt' 'arg
  CALL checkdcd()
  IF(UPPER(opt)='CD') THEN CALL setdir(arg)
  ELSE IF exists(opt)~=0 THEN
    DO
      IF LEFT(STATEF(opt),3)='DIR' THEN CALL setdir(opt)
    END
  ELSE IF opt~='' & UPPER(opt)~='EXIT' THEN
    ADDRESS COMMAND opt '<* >*' arg
END
CALL PRAGMA('D',olddir)
RETURN


yell:
chatrequest=1
IF excuses.1='' THEN
  DO
    IF readopen(bbspath'Lists/Excuses') THEN
      DO
        DO i=1
          line=READLN(f)
          IF EOF(f) THEN BREAK
          excuses.i=line
        END
        excuses.0=i-1
        CALL CLOSE(f)
      END
  END
j=TIME('S')//excuses.0+1
SAY CR
SAY 'Sorry, your SysOp,' sysop','CR
IF excuses.j~='' THEN SAY excuses.j||CR
ELSE SAY 'is not available, please leave a ['pen3'C'def']omment.'CR
SAY CR
IF bbsprefs.13 THEN RETURN
SAY 'I''m yelling anyway...'CR
SAY 'If nobody answers, please try again later or leave a ['pen3'C'def']omment'CR
CALL sound('YELL')
ADDRESS AREXX bbsSpeak.rexx 'CHAT' name bbspath saypath
RETURN


/* online change to member. Sysop triggered by BumpMember.baud */
/* user triggered by Call Back Verification CBV: */
validate:
ARG varg .
IF readopen(bbspath'BBS_TEXT/'varg) THEN
  DO
    SAY CR
    SAY 'You are being validated.  Please wait...'CR
    SAY CR
    DO lvi=1 TO 22
      line=READLN(f)
      IF lvi=11 THEN data.11=line
      IF lvi=20 THEN data.20=line
    END
    data.22=line
    CALL CLOSE(f)
    CALL SetData()
    CALL sortlibraries()
    IF bbsprefs.25=1 THEN
      DO
        data.22=''
        data.23=''
        SAY CR
        SAY 'Setting message counters to last 10 messages in each conference...'CR
        DO i=1 TO level
          num=countcheck(bbspath'Numbers/LastMessage'i 0)-10
          IF num<0 | msg.i.0<10 THEN num=0
          lastread.i=num
          data.22=data.22 num
          data.23=data.23 0
        END
        SAY 'Setting file counter to last file uploaded...'CR
        lastbrowse=countcheck(bbspath'Numbers/LastFile' 0)
        newfilesdate='19900101 00:00:00'
      END
    SAY CR
    CALL logonstats()
    CALL saveData(0)
    IF EXISTS(bbspath'BBS_TEXT/EMAIL_WELCOME') THEN
      DO
        CALL MAKEDIR(bbspath'EMail/'name)
        lastwrit=countcheck(bbspath'Numbers/LastMail' 0)+1
        IF lastwrit>1 THEN CALL countcheck(bbspath'Numbers/LastMail' lastwrit)
        lynes.=''
        lynes.1=' Mail:' lastwrit
        lynes.2=' From:' sysop
        lynes.3='   To:' name
        lynes.4=' Subj: Welcome to' bbsname
        lynes.5=' Date:' DATE('W') DATE()'  'TIME('C')
        lynes.6=LEFT('',74,'=')
        CALL readlines(bbspath'BBS_TEXT/EMAIL_WELCOME' 7)
        CALL savelines(bbspath'EMail/'name'/'sysop'.'lastwrit)
        SAY 'You have welcoming EMail.'CR
      END
    CALL waiting()
    IF bbsprefs.22=2 THEN
      DO
        SAY CR
        SAY pen3||name def'is now a fully valadated member of'pen3 bbsname||def||CR
        SAY 'All the features of the BBS will be available on your next call.'CR
        SAY CR
        CALL waiting()
        SIGNAL LOGOUT2
      END
    SIGNAL RESTART
  END
ELSE
  DO
    SAY 'Sorry. Auto-validation is disabled.'CR
    temp=' ***' sysop'!  You need a default file in BBS_TEXT!  (' varg ') *** '
    MSG bak2||temp||def||CR
    CALL Send2log(temp)
  END
RETURN


/* online time change. Sysop triggered by BumpTime.baud */
uptime:
mins=GETCLIP('BBS_minutes')
IF DATATYPE(mins,'N') THEN
  DO
    IF (mins*60)>maxtime THEN
      SAY name', this session''s time has been increased to' mins 'minutes.'CR
    ELSE MSG '*** User has not been told that his time has decreased.'
    CALL SETCLIP('BBS_minutes')
    maxtime=mins*60
  END
RETURN


/* online level change. Sysop triggered by BumpLevels.baud */
uplevel:
levl=GETCLIP('BBS_level')
IF DATATYPE(levl,'W') THEN
  DO
    IF levl>data.20 THEN
      SAY name', your level has been changed from' data.20 'to' levl'.'CR
    ELSE MSG '*** User has not been told his level has been reduced.'
    data.20=levl
    CALL SetData()
    IF menu='NEW' THEN menu='ALL'
    CALL sortlibraries()
  END
RETURN


/* online ratio change. Sysop triggered by BumpLevels.baud */
upratio:
rats=GETCLIP('BBS_ratio')
IF DATATYPE(rats,'W') THEN
  DO
    SAY name', your upload:download ratio has been changed to 1:'rats'.'CR
    data.17=rats'  'WORD(data.17,2)'  'WORD(data.17,3)
    CALL SETCLIP('BBS_ratio')
  END
RETURN


bytes2user:
PARSE ARG indx bytes .
tfiles=WORD(data.indx,1)
tbytes=WORD(data.indx,3)
IF ~DATATYPE(tfiles,'W') THEN tfiles=0
IF ~DATATYPE(tbytes,'W') THEN tbytes=0
tbytes=tbytes+bytes
tfiles=tfiles+1
IF tfiles>1 THEN data.indx=tfiles 'files' tbytes 'bytes.'
ELSE data.indx='1 file' bytes 'bytes.'
data.indx=data.indx DATE()
CALL saveData(0)
RETURN


stats:
ARG indx
tfail=''
bytes=''
Status z
string=RESULT
IF RIGHT(BB_VERS,4)>1.59 THEN
  DO
    PARSE VAR string . 'Local Name: 'temp . 'Xfer''ed: 'bytes . 'Elapsed Time: 'min':'sec'0A'x .
    slash=LASTPOS('/',temp)
    IF slash=0 THEN slash=LASTPOS(':',temp)
    IF slash~=0 THEN temp=SUBSTR(temp,slash+1)
  END
ELSE PARSE VAR string temp' 'min':'sec . 'Bytes:'bytes .
temp=STRIP(temp)
min=STRIP(min)
sec=STRIP(sec)
bytes=STRIP(bytes)
IF temp~='' & LEFT(UPPER(STRIP(temp)),8)~=LEFT(UPPER(arg),8) THEN
  tfail='wrong file' temp
ELSE IF DATATYPE(min,'W') & DATATYPE(sec,'W') & DATATYPE(bytes,'W') THEN
  DO
    secs=(min*60)+sec
    IF indx=14 THEN CALL DELAY(100) /* wait for dos to finish upload */
    temp=STATEF(PRAGMA('D')'/'arg)
    temp=WORD(temp,2)
    IF ~DATATYPE(temp,'W') THEN temp=0
    IF indx=14 & (temp+1024)<bytes THEN tfail='ul size'
    IF indx=15 & temp>(bytes+1024) THEN tfail='dl size'
  END
ELSE tfail='not numeric: min='min 'sec='sec 'bytes='bytes
IF tfail~='' THEN
  DO
    line=plaindir'/'arg pen3'*** Transfer failed! ***'def
    SAY line||CR
    CALL send2log(line 'tfail:'tfail)
    CALL send2log('***' string)
    CALL sound('TFAIL')
    IF indx=14 & WORD(STATEF(arg),2)=0 THEN CALL DELETE(arg)
    RETURN 1
  END
ELSE IF secs>0 THEN
  Say 'Transfer Speed:' TRUNC(bytes/secs+.05,1) 'characters per second.'CR
Remote OFF
Send '^G'
Remote ON
line=left(arg,16,' ')
IF indx=14 THEN
  DO
    temp=countcheck(bbspath'Numbers/Bytes.UpLoad' 0)+bytes
    CALL countcheck(bbspath'Numbers/Bytes.UpLoad' temp)
    line=line 'uled'
  END
ELSE
  DO
    temp=countcheck(bbspath'Numbers/Bytes.DownLoad' 0)+bytes
    CALL countcheck(bbspath'Numbers/Bytes.DownLoad' temp)
    temp=countcheck(bbspath'Numbers/Files.DownLoad' 0)+1
    CALL countcheck(bbspath'Numbers/Files.DownLoad' temp)
    temp=PRAGMA('D')
    xdev=SPACE(LEFT(temp,POS(':',temp)-1),1,'_')
    tfiles=1
    IF EXISTS(arg'.xdl') THEN
      DO
        IF readopen(arg'.xdl') THEN
          DO
            xdev=READLN(f)
            tfiles=READLN(f)
            CALL CLOSE(f)
          END
      END
    temp=countcheck(bbspath'Numbers/Bytes.X.'xdev 0)+bytes
    CALL countcheck(bbspath'Numbers/Bytes.X.'xdev temp)
    temp=countcheck(bbspath'Numbers/Files.X.'xdev 0)+tfiles
    CALL countcheck(bbspath'Numbers/Files.X.'xdev temp)
    line=line 'dled'
  END
line=line protocol TIME('C') bytes 'bytes' PRAGMA('D')
CALL send2log(line)
RETURN 0


bbsspace:
ARG tabspace .
ADDRESS COMMAND 'C:info >ram:infout' bbsdevice
ok=OPEN(f,'ram:infout','R')
IF ok=0 THEN RETURN 20
line=READLN(f)
line=READLN(f)
line=READLN(f)
line=READLN(f)
CALL CLOSE(f)
IF tabspace<14 THEN SAY CR
bbsk=WORD(line,4)
IF ~DATATYPE(bbsk,'N') THEN
  DO
    line=bbsdevice 'is not an info compatible device!'
    CALL send2log(line)
    SAY pen3||line||def||CR
    bbsk=0
    RETURN
  END
bbsk=bbsk*512-SYSTEM_SPACE_LIMIT
IF bbsk<1 THEN bbsk=0
SAY RIGHT(comma(bbsk),tabspace) 'bytes available for uploads.'CR
RETURN


comma:
ARG num .
dgt=LENGTH(num)
numtext=''
IF dgt>3 THEN numtext=','RIGHT(num,3)
IF dgt>6 THEN numtext=','LEFT(RIGHT(num,6),3)||numtext
IF dgt>9 THEN numtext=','LEFT(RIGHT(num,9),3)||numtext
IF dgt>12 THEN
  DO
    numtext=','LEFT(RIGHT(num,12),3)||numtext
    numtext=LEFT(num,dgt-12)||numtext
  END
ELSE IF dgt>9 THEN numtext=LEFT(num,dgt-9)||numtext
ELSE IF dgt>6 THEN numtext=LEFT(num,dgt-6)||numtext
ELSE IF dgt>3 THEN numtext=LEFT(num,dgt-3)||numtext
ELSE numtext=num
RETURN numtext


is_here:
ARG newname
CALL WRITECH(STDOUT,'Checking filelist')
DO wi=1 TO 99
  IF wi//3=0 THEN CALL WRITECH(STDOUT,'.')
  IF dirs.wi='' THEN ITERATE wi
  IF ~EXISTS(bbspath'FileNotes/'dirs.wi'/'newname) THEN ITERATE wi
  line=pen3'*** File' newname 'already exists here'
  IF wi<=level THEN line=line 'in the' dirs.wi 'directory'
  line=line'.'def
  SAY CR
  SAY line||CR
  SAY 'Original uploader should ['pen3'K'def']ill the file before uploading the replacement.'CR
  CALL waiting()
  RETURN 1
END
SAY CR
CALL cleanline(1)
RETURN 0


uload:
ARG frommenu
IF frommenu THEN
  DO
    SAY CR
    SAY pen3'PLEASE!'def 'Only upload 1 (one) archive at a time. NO BATCH UPLOADING! Thanks.'CR
  END
CALL bbsspace(12)
SAY CR
IF bbsk<1 THEN
  DO
    line='Upload area is full!'
    CALL send2log(line)
    SAY pen3||line||def||CR
    RETURN 1
  END
IF arg='' THEN arg=getinput(0 0 'Filename: ')  /* no filename given */
arg=cleanstring('0:'arg)
arg=COMPRESS(arg,' :/,;|#?*')  /* be sure no illegals here */
x=LASTPOS('/',arg)
IF x=0 THEN x=LASTPOS(':',arg)
IF x>0 THEN
  DO
    IF DATATYPE(SUBSTR(arg,x+1),'W') THEN
      DO
        SAY 'Whole numbers are not allowed as filenames!'CR
        CALL waiting()
        RETURN 1
      END
  END
tempnum=LENGTH(arg)-16
DO WHILE tempnum>0 & POS('EMAILFILES',UPPER(PRAGMA('D')))=0
  temp='          'pen3||arg def'is'pen3 tempnum||def
  IF tempnum=1 THEN temp=temp 'character'
  ELSE temp=temp 'characters'
  temp=temp 'too long for a filename.'
  SAY temp||CR
  arg=getinput(0 0 'Filename: ')
  arg=cleanstring('0:'arg)
  arg=COMPRESS(arg,' :/,;|#?*()+[]"{}')
  tempnum=LENGTH(arg)-16
END
IF arg='' THEN RETURN 1
IF frommenu THEN
  DO
    IF is_here(arg) THEN RETURN 1
    IF wi=999999 THEN RETURN 1
    IF bbsprefs.6=1 & sysoplevel>level THEN CALL setdir(libpath'Sysops')
    ELSE
      DO loop=1
        SAY 'Please select an appropriate library for -' pen3||arg def'-'CR
        temp=chdir()
        IF temp=0 THEN LEAVE loop
        IF temp=2 THEN RETURN 1
      END
  END
checkproto='T'
targ=arg
DO WHILE checkproto='T'
  arg=''
  SAY CR
  SAY 'Library:'pen3 plaindir def'  Filename:'pen3 targ def'  Protocol:'pen3 protocol||def||CR
  pline=' ['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol'
  pline=pline '['pen3'U'def']pload (qtU) > '
  checkproto=getinput(1 1 pline)
  IF checkproto='Q' THEN RETURN 1
  IF checkproto='T' THEN CALL chpro()
END
arg=targ
CALL postuser(4)
CALL sound('UPLOAD')
uploadtime=TIME('E')
SAY 'Starting' protocol 'transfer.  Press' pen3'Esc'def 'to abort.'CR
CALL whodat()
DownLoad arg
IF RC>0 | stats(14) THEN RETURN 2
rbytes=WORD(STATEF(arg),2)
IF rbytes<1 THEN
  DO
    CALL DELETE(arg)
    RETURN 2
  END
temp=''
DO WHILE temp~='N' & temp~='Y'
  temp=getinput(1 1 'Received' rbytes 'bytes. Was your upload successful? (ny) > ')
END
IF temp='N' THEN RETURN 2
IF TestArc.rexx(PRAGMA('D')'/'arg)>0 THEN
  DO
    SAY CR
    SAY pen3'***'def arg pen3'failed archive check!'def||CR
    SAY CR
    temp=getinput(1 1 'Do you believe the archive checker made a mistake? (Ny) > ')
    IF temp~='Y' THEN
      DO
        CALL DELETE(arg)
        SAY CR
        RETURN 2
      END
  END
CALL bytes2user(14 rbytes)
ADDRESS AREXX bbsNewFile.rexx name PRAGMA('D')'/'arg
IF bbsprefs.9 & name~=sysop THEN
  DO
    newufile=bbspath'EMail/'sysop'/NEW_FILES'
    IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
    ELSE
      DO
        ok=OPEN(f,newufile,'W')
        IF ok~=0 THEN CALL WRITELN(f,'*** New Files ***')
      END
    IF ok~=0 THEN CALL WRITELN(f,name 'uploaded' plaindir'/'arg'  'DATE() TIME())
    CALL CLOSE(f)
    CALL sound('NEW_FILE')
  END
IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN 0
DO ui=sysoplevel+2 TO 100
  IF UPPER(dirs.ui)=UPPER(plaindir) THEN RETURN 0     /* no filenotes */
END
IF frommenu THEN
  DO
    uploadtime=TIME('E')-uploadtime
    IF bbsprefs.11 THEN
      DO
        maxtime=maxtime+uploadtime
        line='This session''s time has been increased by'
        line=line TRUNC(uploadtime%60+.05,1)+1 'minutes.'
        SAY CR
        SAY line||CR
      END
    DO WHILE editnote(arg)  /* INSIST on a filenote */
    END
    SAY pen3'Thank you for contributing to the' bbsname 'file libraries!'def||CR
  END
waitchar=''
RETURN 0


findfiles:
PARSE ARG ffile .
IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN ffile
wi=0
IF DATATYPE(ffile,'W') THEN
  DO
    IF WORDS(files.ffile)<2 THEN RETURN 0
    dirtemp=WORD(files.ffile,1)
    IF finddirnum(dirtemp)>level | FIND(data.21,UPPER(dirtemp))>0 THEN
      DO
        CALL illegal_access()
        RETURN 0
      END
    CALL setdir(libpath||dirtemp)
  END
ELSE IF EXISTS(ffile) THEN
  DO
    IF EXISTS(bbspath'FileNotes/'plaindir'/'ffile) THEN
      DO
        IF readopen(bbspath'FileNotes/'plaindir'/'ffile)~=0 THEN
          DO
            line=READLN(f)
            CALL CLOSE(f)
            ffile=WORD(line,2)
          END
      END
  END
ELSE IF EXISTS(bbspath'Information'ffile) THEN
  RETURN bbspath'Information/'ffile
ELSE
  DO
    nextfilenum=countcheck(bbspath'Numbers/LastFile' 0)+1
    CALL busywait(4 1)
    DO ni=nextfilenum TO 0 BY -1
      IF ni=0 THEN
        DO
          CALL busywait(4 0)
          SAY CR
          SAY '***' files.0 'filenames scanned,'pen3 ffile def'is not on the filelist!'CR
          SAY CR
          RETURN 0
        END
      IF ni>1 THEN CALL busywait(60 ni nextfilenum)
      argtemp=WORD(files.ni,2)
      IF UPPER(argtemp)=UPPER(ffile) THEN
        DO
          dirtemp=WORD(files.ni,1)
          jj=files.ni.0
          IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(dirtemp))>0 THEN
            DO
              CALL busywait(4 0)
              CALL illegal_access()
              RETURN 0
            END
          ffile=ni
          CALL setdir(libpath||dirtemp)
          LEAVE ni
        END
    END
    CALL busywait(4 0)
  END
IF wi=999999 THEN RETURN 0
ftemp=ffile
IF DATATYPE(ftemp,'W') THEN ftemp=WORD(files.ftemp,2)
IF ~EXISTS(ftemp) THEN
  DO
    finfo=STATEF(bbspath'FileNotes/'plaindir'/'ftemp)
    IF WORDS(finfo)>7 THEN ftemp=WORD(finfo,8)
    IF ~EXISTS(ftemp) THEN
      DO
        IF finfo='' THEN SAY '***'pen3 PRAGMA('D')'/'ftemp def'was not found!'CR
        ELSE
          DO
            SAY CR
            IF WORDS(finfo)<8 THEN ftemp=plaindir'/'ftemp
            SAY '***'pen3 ftemp def'is not currently available online.'CR
            SAY ' Would you like me to notify the sysop'CR
            SAY ' that you''d like to receive this file?'CR
            IF getinput(1 1 ' (Ny) > ')='Y' THEN
              DO
                enum=countcheck(bbspath'Numbers/LastMail' 0)+1
                CALL countcheck(bbspath'Numbers/LastMail' enum)
                IF writeopen(bbspath'email/'sysop'/'name'.'enum)=0 THEN RETURN
                CALL WRITELN(f,' Mail: 'enum )
                CALL WRITELN(f,' From: 'name)
                CALL WRITELN(f,'   To: 'sysop)
                CALL WRITELN(f,' Subj: File Request')
                CALL WRITELN(f,' Date: 'DATE()'  'TIME('C'))
                CALL WRITELN(f,'====================================================================')
                CALL WRITELN(f,' Mr. Sysop, I would like to have this file : ')
                CALL WRITELN(f,' 'ftemp)
                CALL WRITELN(f,' ')
                CALL CLOSE(f)
                SAY CR
                ADDRESS AREXX bbsSpeak.rexx 'FILE_REQUEST' name bbspath saypath
                SAY 'Your file request has been sent!'CR
                SAY 'The file should be in your Email soon.'CR
              END
            SAY CR
          END
        RETURN 0
      END
  END
RETURN ffile


illegal_access:
SAY CR
SAY '*** You are not authorized to access' ffile'!'CR
SAY '*** Send Email to' sysop 'to receive a higher level.'CR
SAY CR
IF DATATYPE(ffile,'W') THEN ffile=ffile WORD(files.ffile,2)
CALL send2log('Illegal Access Attempt!' ffile 'in' dirtemp)
RETURN


statuscheck:
PARSE ARG ffile
updownratio=WORD(data.17,1)
IF ~DATATYPE(updownratio,'N') THEN updownratio=100
upbytes=WORD(data.14,3)
IF ~DATATYPE(upbytes,'W') | upbytes<1 THEN upbytes=1
dnbytes=WORD(data.15,3)
IF ~DATATYPE(dnbytes,'W') | dnbytes<1 THEN dnbytes=1
dbytes=WORD(STATEF(ffile),2)
IF ~DATATYPE(dbytes,'W') THEN dbytes=1
IF ~DATATYPE(bps,'W') THEN bps=2400
needtime=dbytes%(bps%10)+10  /* plus 10 seconds for handshaking? */
SAY CR
SAY CR
CALL showtime()
SAY 'At least' TRUNC(needtime/60+.05,1) 'minutes needed to download' ffile 'at' bps 'baud.'CR
SAY 'After this transfer your upload:download ratio will be 1:'TRUNC((dbytes+dnbytes)/upbytes)||CR
IF level>(sysoplevel+1) | POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN 0
IF (needtime+TIME('E'))>maxtime THEN
  DO
    SAY CR
    SAY 'Sorry, not enough time left in this session to download' dbytes 'bytes.'CR
    IF needtime>(WORD(data.11,1)*60) THEN
      SAY 'Leave email to the sysop to make other arrangements to receive this file.'CR
    SAY CR
    RETURN 1
  END
IF updownratio>0 & (dnbytes/upbytes)>updownratio THEN
  DO
    SAY CR
    line=pen3'       *** You must upload before you do any more downloading! ***'def
    SAY line||CR
    SAY '  Maintain a ratio of at least 1 byte uploaded for each' updownratio 'bytes downloaded.'CR
    IF bbsprefs.4 THEN RETURN 1
    SAY pen3'             - This requirement is temporarily suspended. -'def||CR
    SAY CR
  END
RETURN 0


ext_dload:
SAY CR
CALL checkdcd()
allargs=bbsExtDL.baud(name level TRUNC(maxtime-TIME('E')) linesperpage colorflag extdevs)
IF allargs='' | TRUNC(maxtime-TIME('E'))<30 THEN RETURN
CALL dload2()
RETURN


dload:
arg=STRIP(arg data.25)
data.25=''
curdir=PRAGMA('D')
OPTIONS PROMPT 'Filenames and/or numbers: '
IF arg='' THEN PARSE PULL arg  /* no filename given */
IF arg='' THEN RETURN 0
allargs=TRANSLATE(arg,'     ',':/,;|')
tempargs=SPACE(allargs,1)
numchk=1
DO ui=1 TO WORDS(tempargs) WHILE STRIP(allargs)~=''
  arg=WORD(tempargs,ui)
  IF ~DATATYPE(arg,'W') THEN numchk=0
  wloc=WORDINDEX(allargs,FIND(allargs,arg))
  wi=0
  temp=findfiles(arg)
  IF wi=999999 THEN RETURN 0
  IF temp~=arg THEN
    DO
      allargs=DELWORD(allargs,FIND(allargs,arg),1)
      IF temp~=0 THEN allargs=INSERT(temp' ',allargs,wloc-1)
    END
END
IF numchk=0 THEN
  IF countcheck(bbspath'Numbers/LastFile' 0)>500 THEN
    DO
      SAY LEFT('',20)||CR
      SAY bak2' BBBBS Tip:'def'  Next time try using fileNUMBERS instead of fileNAMES.'CR
      SAY '              The BBS is MUCH faster at locating files by number.'CR
    END

dload2:
curdir=PRAGMA('D')
allargs=STRIP(allargs data.25)
data.25=''
IF allargs='' THEN RETURN 0
sleepy='T'
DO WHILE sleepy='T'
  arg=''
  SAY LEFT('',20)||CR
  temp=WORD(allargs,1)
  IF DATATYPE(temp,'W') THEN temp=WORD(files.temp,2)
  test=''
  IF LENGTH(temp)>40 THEN
    DO
      test=temp
      temp=''
    END
  SAY 'Filename(s)'pen3 LEFT(temp,40) def'Protocol:'pen3 protocol||def||CR
  IF test~='' THEN SAY '           'pen3 test||def||CR
  DO di=2 TO WORDS(allargs)
    temp=WORD(allargs,di)
    IF DATATYPE(temp,'W') THEN temp=WORD(files.temp,2)
    SAY '           'pen3 temp||def||CR
  END
  pline='['pen3'A'def']uto-Logoff-after-transfer ['pen3'D'def']ownload'
  pline=pline '['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol (aDqt)'
  sleepy=getinput(1 1 pline '> ')
  IF sleepy='Q' THEN RETURN 0
  IF sleepy='A' THEN sleepy='LOGOFF'
  IF sleepy='T' THEN CALL chpro()
END
DO WHILE allargs~=''
  errorflag=0
  extdir=''
  arg=WORD(allargs,1)
  allargs=STRIP(DELWORD(allargs,1,1))
  IF DATATYPE(arg,'W') THEN
    DO
      CALL setdir(libpath||WORD(files.arg,1))
      arg=WORD(files.arg,2)
    END
  notename=bbspath'FileNotes/'plaindir'/'arg
  finfo=''
  IF ~EXISTS(arg) THEN
    DO
      finfo=STATEF(notename)
      IF WORDS(finfo)>7 THEN
        DO
          temp=plaindir
          x=lastslash(WORD(finfo,8))
          arg=WORD(x,1)
          CALL setdir(WORD(x,2))
          plaindir=temp
        END
    END
  x=lastslash(arg)
  IF WORDS(x)>1 THEN
    DO
      arg=WORD(x,1)
      extdir=WORD(x,2)
      CALL setdir(extdir)
    END
  DO dloadloop=1
    IF statuscheck(arg) THEN
      DO
        errorflag=1
        LEAVE dloadloop
      END
    CALL postuser(5)
    CALL sound('DOWNLOAD')
    SAY 'Starting' protocol 'transfer.  Press' pen3'Esc'def 'to abort.'CR
    CALL checktime()
    UpLoad arg
    IF RC>0 | stats(15) THEN
      DO
        errorflag=1
        LEAVE dloadloop
      END
    CALL bytes2user(15 WORD(STATEF(arg),2))
    IF extdir='' & POS('EMAILFILES',UPPER(PRAGMA('D')))=0 THEN
      DO dloadloop2=1 TO 1
        DO di=sysoplevel+2 TO 100
          IF UPPER(dirs.di)=UPPER(plaindir) THEN LEAVE dloadloop2
        END
        IF readlines(notename 1) THEN
          DO
            CALL send2log('Unable to increment download count for' plaindir'/'arg)
            LEAVE dloadloop2
          END
        dls=WORD(lynes.2,7)
        IF ~DATATYPE(dls,'W') THEN dls=0
        lynes.2=STRIP(DELWORD(lynes.2,7,1)) dls+1
        finfo=STATEF(notename)
        IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8))
        ELSE finfo=''
        CALL DELETE(notename)
        CALL savelines(notename)
        CALL DELAY(28)
        IF finfo~='' THEN ADDRESS COMMAND 'C:filenote' notename finfo
        IF WORD(data.16,1)<WORD(lynes.1,2) THEN
          DO
            lastbrowse=WORD(lynes.1,2)
            newfilesdate=DATE('S') TIME()
          END
      END
    LEAVE dloadloop
  END
END
CALL setdir(curdir)
IF errorflag THEN SAY pen3'*** Download Failed!'def||CR
IF sleepy='LOGOFF' THEN
  DO
    SAY CR
    SAY 'Logging'pen3 'OFF' def'in 10 seconds...'CR
    SAY 'Press'pen3 RETURN def'to return to'pen3 bbsname||def||CR
    SAY CR
    Timeout 10
    WAIT '?'
    t=RC
    Timeout maxidle
    IF t~=0 THEN SIGNAL LOGOUT2
  END
RETURN errorflag


lastslash:
PARSE ARG sarg
sdir=''
slash=LASTPOS('/',sarg)
IF slash>2 THEN sdir=LEFT(sarg,slash-1)
ELSE
  DO
    slash=LASTPOS(':',sarg)
    IF slash>0 THEN sdir=LEFT(sarg,slash)
  END
IF slash>0 THEN sarg=SUBSTR(sarg,slash+1)
RETURN sarg sdir


editnote:
IF arg='' THEN
  DO
    PARSE PULL arg .
    IF arg='' THEN RETURN 0
  END
comment=''
IF ~EXISTS(arg) THEN
  DO
    finfo=STATEF(bbspath'FileNotes/'plaindir'/'arg)
    temp=''
    IF WORDS(finfo)>7 THEN comment=WORD(finfo,8)
    ELSE
      DO
        IF level<sysoplevel THEN RETURN 0
        temp=getinput(1 1 'Is this file on an another device? (Nqy)')
      END
    IF temp='Y' THEN
      DO WHILE comment=''
        OPTIONS PROMPT 'Enter linkfile using full dev:path/filename > '
        PARSE PULL comment
        comment=STRIP(comment)
        IF comment='' THEN RETURN 0
        IF ~EXISTS(comment) THEN comment=''
      END
    ELSE IF temp='Q' THEN RETURN 0
  END
IF comment='' THEN
  DO
    arg=findfiles(arg)
    IF arg=0 THEN RETURN 0
    IF DATATYPE(arg,'W') THEN arg=WORD(files.arg,2)
  END
filedir=plaindir
CALL MAKEDIR(bbspath'FileNotes/'filedir)
IF ~EXISTS(bbspath'FileNotes/'filedir) THEN
  DO
    SAY pen3'*** Failed to open directory!' filedir||def||CR
    RETURN 0
  END
notename=bbspath'FileNotes/'filedir'/'arg
lynes.=''
filenum=countcheck(bbspath'Numbers/LastFile' 0)
IF level>sysoplevel THEN firstedit=1
ELSE firstedit=5
IF EXISTS(notename) THEN
  DO
    IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
    CALL bbsED(firstedit notename)
    RETURN 0
  END
IF comment='' THEN filedata=STATEF(libpath||filedir'/'arg)
ELSE filedata=STATEF(comment)
IF filedata='' THEN
  DO
    IF comment='' THEN line=filedir'/'arg
    ELSE line=comment
    SAY line 'does not exist!'CR
    RETURN 0
  END
bytes=WORD(filedata,2)
filenum=filenum+1
lynes.0=4
lynes.1='File: 'LEFT(filenum,5)' KeyWords:'
lynes.2='Name: 'LEFT(arg,27)' Size: 'bytes' bytes   Downloads: 0'
lynes.3='From: 'LEFT(name,27)' Date: 'DATE() TIME('C')'  Lib: 'filedir
lynes.4=LEFT('',74,'=')
lynes.1=lynes.1 edkeywords(arg filedir)
CALL seelines(1)
edtype=''
CALL writebuffer(scratch'/NoteFile')
IF savelines(notename) THEN RETURN 0
IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
fncom='R'
DO WHILE fncom='R'
  CALL seelines(1)
  nonstop=0
  line='['pen3'E'def']dit'
  IF level>sysoplevel THEN line=line '['pen3'K'def']ill'
  line=line '['pen3'R'def']ead ['pen3'S'def']ave'
  IF level>sysoplevel THEN line=line '(ekrS) 'def
  ELSE line=line '(erS) 'def
  fncom=getinput(1 1 line)
  IF fncom='K' & level>sysoplevel THEN
    DO
      SAY 'Killing FileNote..'CR
      CALL DELETE(notename)
      RETURN 1
    END
  ELSE IF fncom='E' THEN
    DO
      IF bbsED(firstedit notename)>0 THEN RETURN 0
      fncom='R'
    END
  ELSE IF fncom~='R' THEN
    DO
      SAY 'Adjusting filelist...'CR
      IF filenum<1 THEN filenum=1
      IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',1)
      CALL countcheck(bbspath'Numbers/LastFile' filenum)
      files.0=files.0+1
      newcount=alpha.0+1
      alpha.0=newcount
      files.filenum=plaindir arg
      files.filenum.0=newcount
      libnum=finddirnum(plaindir)
      PARSE VAR lynes.1 . 'KeyWords:' keywords
      alpha.newcount=LEFT(arg,22-LENGTH(WORD(lynes.2,4)))
      alpha.newcount=alpha.newcount WORD(lynes.2,4) RIGHT(filenum,5)
      alpha.newcount=alpha.newcount RIGHT(libnum,2) LEFT(plaindir,12)
      alpha.newcount=alpha.newcount STRIP(LEFT(STRIP(keywords),32))
      IF EXISTS(bbspath'Lists/Files') THEN
        x=OPEN(f,bbspath'Lists/Files','A')
      ELSE x=OPEN(f,bbspath'Lists/Files','W')
      IF x=0 THEN
        DO
          SAY '*** Failed to open' bbspath'Lists/Files'CR
          RETURN 0
        END
      CALL WRITELN(f,filenum files.filenum)
      CALL CLOSE(f)
      IF EXISTS(bbspath'Lists/Files.ALPHA') THEN
        x=OPEN(f,bbspath'Lists/Files.ALPHA','A')
      ELSE x=OPEN(f,bbspath'Lists/Files.ALPHA','W')
      IF x=0 THEN
        DO
          SAY '*** Failed to open' bbspath'Lists/Files.ALPHA'CR
          RETURN 0
        END
      CALL WRITELN(f,alpha.newcount)
      CALL CLOSE(f)
      sortalphaflag=1
      savefileflag=1
      CALL cleanline(1)
    END
END
RETURN 0


edkeywords:
PARSE ARG kwarg
templine=''
DO WHILE LENGTH(templine)<3
  SAY CR
  SAY pen3'Please enter a list of keywords (or a condensed description)'def||CR
  SAY pen3'to be used in the alphabetic list and by the search routine.'def||CR
  SAY '    Note that only the first 32 characters will be used.'CR
  SAY LEFT('',43)'|'LEFT('',31,'=')'|'CR
  templine=getinput(0 0 ' 'RIGHT(STRIP(RIGHT(kwarg,32)),32) pen3'KeyWords: 'def)
  templine=cleanstring('0:'templine)
  templine=STRIP(LEFT(templine,32))
END
SAY CR
RETURN templine


loadfiles:
SAY def||CR
SAY 'Loading filelist...'CR
files.=''
files.0=0
IF readopen(bbspath'Lists/Files') THEN
  DO
    DO i=1
      line=READLN(f)
      IF EOF(f) THEN BREAK
      num=WORD(line,1)
      IF DATATYPE(num,'W') THEN files.num=WORD(line,2) WORD(line,3)
    END
    files.0=i-1
    CALL CLOSE(f)
  END
RETURN


savefilelist:
IF level=99 THEN
  IF getinput(1 1 'Update filelists now? (nY) > ')='N' THEN RETURN

savefilelist2:
SIGNAL OFF BREAK_E
IF ckmaint('FILES') THEN RETURN
CALL savealphalist()
SAY 'Saving filelist...'CR
CALL SETCLIP('BBS_maint',1)
xarg=bbspath'Lists/Files'
CALL DELETE(xarg)
filenum=countcheck(bbspath'Numbers/LastFile' 0)
IF filenum<1 | writeopen(xarg)=0 THEN RETURN
DO i=1 TO filenum
  IF files.i='' THEN ITERATE i
  CALL WRITELN(f,i files.i)
END
CALL CLOSE(f)
CALL SETCLIP('BBS_maint')
savefileflag=0
IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',2)
RETURN


loadalpha:
SAY def||CR
SAY 'Loading the alphabetical filelist...'CR
IF readopen(bbspath'Lists/Files.ALPHA') THEN
  DO
    alpha.=''
    alpha.0=0
    DO i=1
      line=READLN(f)
      IF EOF(f) THEN BREAK
      fnum=WORD(line,3)
      IF DATATYPE(fnum,'W') THEN
        DO
          alpha.i=line
          files.fnum.0=i
        END
      ELSE i=i-1
    END
    CALL CLOSE(f)
    alpha.0=i-1
    IF alpha.0<files.0 THEN buildalpha=1
  END
ELSE SAY pen3'*** Lists/Files.ALPHA failed to open for reading!'def||CR
SAY CR
RETURN


ckmaint:
ARG ckfile .
IF GETCLIP('BBS_maint')~='' THEN
  DO
    DO i=0 TO 23 WHILE GETCLIP('BBS_maint')~=''
      IF i//2=0 THEN SAY 'Waiting' (24-i)*5 'more seconds for' ckfile 'list update to finish...'CR
      CALL DELAY(250)
    END
    IF i>23 THEN
      DO
        line='*** unable to update' ckfile 'list.'
        CALL send2log(line DATE() TIME('C'))
        SAY line||CR
        RETURN 1
      END
  END
RETURN 0


savealphalist:
SIGNAL OFF BREAK_E
IF ckmaint('ALPHA') THEN RETURN
CALL SETCLIP('BBS_maint',1)
IF GETCLIP('BBS_localfiles')~='' THEN
  DO
    CALL SETCLIP('BBS_localfiles')
    CALL loadfiles()
    CALL loadalpha()
  END
aarg=bbspath'Lists/Files.ALPHA'
CALL DELETE(aarg)
IF sortalphaflag=1 THEN
  DO
    SAY 'Alphabetizing' alpha.0 'files...'CR
    CALL QSORT(1,alpha.0,alpha)
    DO i=1 TO alpha.0
      fnum=WORD(alpha.i,3)
      files.fnum.0=i
    END
  END
sortalphaflag=0
IF writeopen(aarg)=0 THEN
  DO
    SAY '*** Error opening' aarg '!'CR
    CALL SETCLIP('BBS_maint')
    RETURN
  END
SAY 'Saving alphabetical filelist...'CR
DO i=1 TO alpha.0
  ii=WORD(alpha.i,3)
  IF files.ii='' THEN alpha.i='0 0' ii '100'
  IF LEFT(alpha.i,4)~='0 0 ' THEN CALL WRITELN(f,alpha.i)
END
CALL CLOSE(f)
CALL SETCLIP('BBS_maint')
ADDRESS AREXX bbsALPHA.rexx SUBSTR(extension,2) arccom
RETURN


viewuser:
SAY CR
SAY bak2' 'name' 'def||CR
DO i=1 TO 18
  stuff=data.i
  IF i=13 | i=14 THEN stuff=DATE(,data.i,'S')
  SAY RIGHT(i,2)||pen3 text.i||def':' stuff||CR
END
CALL waiting()
RETURN


edituser:
IF getinput(1 1 'Change ['pen3'U'def']ser data or ['pen3'M'def']essage conference access (mU) > ')='M' THEN
  DO
    SAY CR
    SAY pen3'     - Message Conference Access -'def||CR
    SAY '[O]ff turns all message conferences OFF.'CR
    SAY 'Set the last message read by you in ALL message conferences'CR
    temp=getinput(1 1 ' ['pen3'L'def']ast  ['pen3'F'def']irst  ['pen3'O'def']ff  ['pen3'Q'def']uit  (fLoq) > ')
    IF temp='Q' THEN RETURN
    SAY 'Resetting...'lineup||CR
    data.22=''
    DO i=1 TO level
      IF temp='F' THEN num=0
      ELSE IF temp='O' THEN num=-1
      ELSE num=countcheck(bbspath'Numbers/LastMessage'i 0)
      data.22=data.22 num
    END
    CALL SetData()
    CALL sortconferences()
    CALL savedata(1)
    RETURN
  END
new=0
change=0
edata.=''
edname=name
DO i=0 TO data.0
  edata.i=data.i
END
num=1
DO WHILE num~='' | edname~=name
  IF num='' | LEFT(num,1)='Q' THEN
    DO
      IF change THEN
        DO
          CALL SetData()
          CALL saveData(1)
          change=0
        END
      IF new THEN
        DO
          data.=''
          DO i=0 TO edata.0
            data.i=edata.i
          END
          name=edname
          new=0
        END
      CALL SetData()
    END
  maxnum=10
  IF edata.20>sysoplevel THEN maxnum=20
  IF edata.20=99 THEN maxnum=27
  SAY bak2' 'name' 'def||CR
  maxlines=21
  IF maxnum=10 THEN maxlines=20
  DO i=1 TO maxlines
    IF i=5 & name~=edname & edata.20<99 THEN ITERATE
    SAY RIGHT(i,2)||pen3 text.i||def':' data.i||CR
  END
  IF edata.20>sysoplevel THEN
    DO
      line=LEFT(' ',50)
      IF name=edname THEN line=line'NEW = Change User.'
      line=pen3||line||def||lineup
      SAY line||CR
    END
  num=getinput(1 0 'Select Line Number To Edit: ')
  IF num='NEW' & edata.20>sysoplevel & edname=name THEN    /* select a new user */
    DO
      new=1
      IF change THEN
        DO
          CALL SetData()
          CALL saveData(1)
        END
      change=0
      nufile=bbspath'Lists/NEW_USERS'
      IF EXISTS(nufile) THEN
        IF ~readlines(nufile 1) THEN CALL seelines(0)
      savename=name
      name=getinput(1 0 'New User Name: 'def)
      name=cleanstring(1':'name)
      IF loadData()=0 THEN name=savename
      IF data.20>=edata.20 THEN
        DO
          SAY 'Can''t Edit!' pen3||name def'has an equal or higher level than thee.'
          name=savename
          CALL loadData()
        END
    END
  ELSE IF DATATYPE(num,'W') & num>0 THEN
    DO
      IF num>maxnum THEN
        DO
          SAY CR
          SAY pen3'You are not authorized to change that information!'def||CR
          SAY CR
        END
      ELSE
        DO dummy=1 TO 1
          IF num=8 THEN
            DO
              SAY CR
              SAY 'Use spaces to separate options.'CR
              SAY 'If the option word is in line 8, it is ON.'CR
              SAY 'Valid Options:'CR
              SAY '        COLOR  turns ANSI color codes ON.'CR
              SAY '        MENU   combines all main commands into 1 menu.'CR
              SAY '        MENUS  splits main commands into 3 menus.'CR
              SAY '        PHONE  makes your phone number public.'CR
              SAY '        QUICK  activates offline options. See bbsQUICK.DOC'CR
              SAY '        STREET makes your street address public.'CR
              SAY '        TERSE  skips some of the logon procedures.'CR
              SAY CR
            END
          line=RIGHT(num,2)||pen3 text.num||def': '
          SAY line||data.num||CR
          temp=getinput(0 0 line)
          IF temp='' THEN
            DO
              IF num=1 | num=4 | num=5 | num=6 | num=7 THEN LEAVE dummy
              IF num=11 | num=12 | num=13 | num=20 THEN LEAVE dummy
            END
          IF num=5 | num=8 THEN temp=UPPER(temp)
          IF num=20 & DATATYPE(temp,'W') & temp>=edata.20 THEN
            temp=data.20
          IF edata.20>sysoplevel & name~=edname THEN line2=name' '
          ELSE line2=''
          IF num=21 & name=edname & edata.20<99 THEN LEAVE dummy
          line=text.num':' data.num pen6'CHANGED TO'def temp
          CALL send2log(line2||line)
          data.num=temp
          SAY line||CR
          SAY CR
          change=1
        END
    END
END
IF change THEN
  DO
    CALL SetData()
    CALL saveData(1)
  END
RETURN


getnumber:
PARSE ARG tprompt
tnum=getinput(1 0 '  'tprompt' > ')
mask=COMPRESS(XRANGE(),'0123456789')
tnum=COMPRESS(tnum,mask)
IF ~DATATYPE(tnum,'W') THEN tnum=0
tnum=tnum%1
IF tnum>0 & tnum<10 THEN tnum='0'tnum
RETURN tnum


getbirth:
data.12=WORD(data.12,1)'  'WORD(data.12,2)'  Birthday:'
SAY pen3'Please enter your birthday.'def||CR
month=getnumber('month: (1-12)')
day=getnumber('  day: (1-31)')
year=getnumber(' year:       ')
IF year<100 THEN year=year+1900
born=year||month||day
IF born<18750101 | born>(DATE('S')-50000) THEN   /* must be older than 4 */
  DO
    born=''
    IF getinput(1 1 'Would you rather skip this question? (Ny) > ')~='Y' THEN
      CALL getbirth()
  END
data.12=WORD(data.12,1)'  'WORD(data.12,2)'  'WORD(data.12,3)' 'WORD(born,1)
RETURN


getname:
CALL showuserlist()
SAY CR
pline='Please enter your full Email name : '
name=getinput(1 0 pline)
IF name='' THEN
  DO
    name=getinput(1 0 pline)
    IF name='' THEN
      DO
        SAY 'No name, no entry.  Bye!'CR
        SIGNAL DONE
      END
  END
name=cleanstring(1':'name)
IF FIND(userlist,name)>0 | FIND(exclusion,name)>0 THEN
  DO
    SAY 'Sorry! That name is taken. Please try again.'CR
    RETURN 1
  END
RETURN 0


/** see if name is in data */

checkUser:
tries=0
IF name='NEW' THEN
  DO
    name=''
    DO WHILE getname()
    END
    CALL postuser(7)
  END
IF FIND(userlist,name)=0 THEN
  DO
    IF EXISTS(bbspath'BBS_TEXT/NEW') THEN
      DO
        nonstop=0
        CALL readlines(bbspath'BBS_TEXT/NEW' 1)
        CALL seelines(0)
        CALL waiting()
      END
    SAY CR
    IF getinput(1 1 'Do you want to register? (nY) > ')='N' THEN
      DO
        SAY 'Thanks anyway, bye!'CR
        line=name 'did not want to register.'
        SIGNAL OUT2
      END
    defile=bbspath'BBS_TEXT/DEF.NEW_USER'
    CALL loadcourtesy()
    wordnum=FIND(courtesy,name)
    IF wordnum>0 THEN
      DO
        SAY name', is on the Courtesy List. You will be granted immediate access.'CR
        courtesy=STRIP(DELWORD(courtesy,wordnum,1))
        IF writeopen(bbspath'Lists/Courtesy') THEN
          DO
            DO i=1 TO WORDS(courtesy)
              CALL WRITELN(f,WORD(courtesy,i))
            END
            CALL CLOSE(f)
          END
        defile=bbspath'BBS_TEXT/DEF.COURTESY'
      END
    ELSE IF bbsprefs.7=0 THEN SAY name', You have new user access.'CR
    IF readlines(defile 1) THEN SIGNAL DONE
    CALL sound('NEW_USER')
    data.=''
    data.0=24
    DO i=6 TO 22
      data.i=lynes.i
    END
    data.12=DATE('S')'  'TIME('C')
    data.13=data.12
    lastondate=DATE('I')-1
    lastontime=TIME('C')
    x=FIND(UPPER(data.8),'COLOR')
    test=getinput(1 1 'Does your terminal handle' pen3'ANSI color'def 'codes? (nY) > ')
    IF test='N' THEN
      DO
        IF x>0 THEN data.8=DELWORD(data.8,x,1)
        CALL colors(0)
      END
    ELSE IF x=0 THEN
      DO
        data.8=data.8 'COLOR'
        CALL colors(1)
      END
    SAY 'Please enter the password you would like to use here.'CR
    data.5=getinput(1 0 'Password: ')
    IF data.5='' THEN
      DO
        line=''name 'refused to enter a password.'
        SIGNAL DONE
      END
    data.1=''
    DO WHILE data.1=''
      data.1=getinput(0 0 'Full Name: ')
      IF data.1='' THEN SAY 'You MUST leave your real name!'CR
    END
    data.2=getinput(0 0 'Street: ')
    data.3=getinput(0 0 'City, State Zip: ')
    data.4=''
    DO WHILE data.4=''
      data.4=getinput(0 0 'Phone: ')
      IF data.4='' THEN
        SAY sysop 'MUST be able to reach you by phone to validate you!'CR
    END
    CALL getbirth()
    IF bbsprefs.8 THEN
      DO
        newufile=bbspath'Lists/NEW_USERS'
        IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
        ELSE
          DO
            ok=OPEN(f,newufile,'W')
            IF ok~=0 THEN CALL WRITELN(f,'*** New Users ***')
          END
        IF ok~=0 THEN
          DO
            temp=RIGHT(TIME('C'),7) COMPRESS(DATE())
            temp=temp LEFT(name,24)'=' data.1'  'data.4
            CALL WRITELN(f,temp)
          END
        CALL CLOSE(f)
      END
    data.9=getinput(0 0 'Computer: ')
    data.10=getinput(0 0 'Interests: ')
    test=getinput(1 1 pen3'Do you want other users to see your STREET address? (Ny) > 'def)
    IF test='Y' THEN data.8=data.8 'STREET'
    test=getinput(1 1 pen3'Do you want other users to see your PHONE number? (Ny) > 'def)
    IF test='Y' THEN data.8=data.8 'PHONE'
    IF bbsprefs.7>0 THEN
      DO
        data.20=bbsprefs.7
        data.11='60 minutes' bbsprefs.16-1 'more times today'
      END
    SAY CR
    CALL SetData()
    IF data.20=0 THEN
      SAY 'Thank you, the sysop will give you higher access soon.'CR
    ELSE IF bbsprefs.25=1 THEN
      DO
        data.22=''
        data.23=''
        SAY CR
        SAY 'Setting message counters to last 10 messages in each conference...'CR
        DO i=1 TO level
          num=countcheck(bbspath'Numbers/LastMessage'i 0)-10
          IF num<0 | msg.i.0<10 THEN num=0
          lastread.i=num
          data.22=data.22 num
          data.23=data.23 0
        END
        SAY 'Setting file counter to last file uploaded...'CR
        lastbrowse=countcheck(bbspath'Numbers/LastFile' 0)
        newfilesdate='19900101 00:00:00'
      END
    SAY CR
    SAY 'Please feel free to leave additional info by using [C]omment.'CR
    SAY CR
    CALL saveData(1)
    SAY 'Adding' name 'to the user list...'CR
    newpassword=data.5
    sortuserflag=1
    temp=countcheck(bbspath'Numbers/Users' 0)+1
    CALL countcheck(bbspath'Numbers/Users' temp)
    CALL DELETE(bbspath'Lists/USERS')
  END
ELSE
  DO
    IF loadData()=0 THEN SIGNAL DONE
    PARSE VAR data.11 amins . atimes .
    lastondate=DATE('I',WORD(data.13,1),'S')
    lastontime=WORD(data.13,2)
    IF DATE('I')>lastondate | level>=sysoplevel THEN atimes=bbsprefs.16
    IF level=99 THEN amins=120
    data.13=DATE('S')'  'TIME()
    data.11=amins 'minutes' atimes-1 'more times today'
    IF atimes<1 & DATE('I')=lastondate THEN
      DO
        SAY CR
        SAY CR
        line= 'Too many calls today.   Call tomorrow.'
        SAY line||CR
        SAY CR
        SAY CR
        CALL send2log(line)
        city=docity(data.3)
        SIGNAL LOGOUT
      END
    data.13=DATE('S')'  'TIME('C')
    SAY pen3'Password will'def 'NOT' pen3'be echoed.'def||CR
    SAY CR
    passprompt='Enter Password: '
    DO tries=1 TO 3
      Send passprompt
      Remote OFF
      OPTIONS PROMPT ''
      newpassword=getinput(1 0 '')
      Remote ON
      IF(password=newpassword) THEN
        DO
          SAY ''CR
          LEAVE tries; /* correct password */
        END
      IF tries=3 THEN
        DO             /* 3 tries, hang up */
          SAY ''CR
          SAY 'Access terminated.'CR
          line='*** Bad password ***' newpassword '***'
          SAY line||CR
          city=line
          CALL postuser(6)
          SIGNAL OUT2
        END
      SAY ''lineup'                                 'CR
      passprompt='Incorrect.  Password: ' /* ask again */
    END
  END
SAY CR
IF bbsprefs.23=1 THEN ADDRESS AREXX bbsSpeak.rexx 'LOGON' name bbspath saypath
RETURN


saveData:
ARG messflag .
IF data.5='' THEN RETURN
temp=GETCLIP(name'_UPDATE')
IF temp~='' THEN
  DO
    CALL SETCLIP(name'_UPDATE')
    PARSE VAR temp upfiles' 'upbytes' 'upmail' 'upmsg
    IF upfiles>0 THEN
      DO
        files=WORD(data.14,1)
        bytes=WORD(data.14,3)
        IF DATATYPE(files,'W') THEN upfiles=upfiles+files
        IF DATATYPE(bytes,'W') THEN bytes=upbytes
        data.14=upfiles 'files' bytes 'bytes.' DATE()
      END
    IF upmail>0 THEN
      DO
        mail=WORD(data.17,2)
        IF DATATYPE(mail,'W') THEN upmail=upmail+mail
        data.17=WORD(data.17,1) upmail WORD(data.17,3)
      END
    IF upmsg~='' THEN
      DO
        temp=data.23
        DO i=1 TO level
          msg=WORD(temp,i)
          IF ~DATATYPE(msg,'W') THEN msg=0
          IF FIND(upmsg,i) THEN msg=msg+1
          data.23=data.23 msg
        END
      END
  END
SAY 'Updating...             'lineup||CR
SIGNAL OFF BREAK_E
Status Trans
data.6=STRIP(RESULT)
IF newfilesdate~='' THEN data.16=lastbrowse newfilesdate
ELSE IF lastbrowse>0 THEN
  DO
    IF WORDS(data.16)>1 THEN data.16=DELWORD(data.16,1,1)
    ELSE data.16=DATE('S') TIME()
    data.16=lastbrowse data.16
  END
IF messflag THEN
  DO
    userexclude.=0
    DO si=1 TO WORDS(data.22)
      IF WORD(data.22,si)=-1 THEN userexclude.si=1
    END
    data.22=''
    data.23=''
    DO si=1 TO level
      IF ~DATATYPE(lastread.si,'W') THEN lastread.si=0
      IF userexclude.si THEN data.22=data.22 '-1'
      ELSE data.22=data.22 lastread.si
      IF ~DATATYPE(totwrit.si,'W') THEN totwrit.si=0
      data.23=data.23 totwrit.si
    END
  END
IF writeopen(bbspath'USERS/'name)=0 THEN RETURN
IF data.0<27 THEN data.0=27
DO i=1 TO data.0
  CALL WRITELN(f,data.i)
END
CALL CLOSE(f)
SAY 'User' name 'has been updated.'CR
RETURN


loadData:
IF name='' THEN RETURN 0
IF ~readopen(bbspath'USERS/'name) THEN RETURN 0
data.=''
DO i=1
  line=READLN(f)
  IF EOF(f) THEN BREAK
  data.i=line
END
data.0=i-1
CALL CLOSE(f)
winnings=WORD(data.18,1)
IF ~DATATYPE(winnings,'N') THEN winnings=0

setData:
IF WORDS(data.16)<3 THEN data.16='0 19900101 00:00:00'
lastbrowse=WORD(data.16,1)
IF ~DATATYPE(lastbrowse,'W') THEN lastbrowse=0
level=data.20
DO i=1 TO level
  lastread.i=WORD(data.22,i)
  IF ~DATATYPE(lastread.i,'W') THEN lastread.i=0
  totwrit.i=WORD(data.23,i)
  IF ~DATATYPE(totwrit.i,'W') THEN totwrit.i=0
END
password=data.5
IF data.6='' THEN
  DO
    Status Trans
    data.6=RESULT
  END
ELSE
  DO
    IF RIGHT(UPPER(data.6),2)='-G' THEN data.6='G'
    IF RIGHT(UPPER(data.6),3)='-1K' THEN data.6='K'
    IF LEFT(UPPER(data.6),1)='A' THEN data.6='Z'
    Set UPPER(LEFT(data.6,1))
  END
IF ~DATATYPE(data.7,'W') THEN data.7=20
IF data.7<5 THEN data.7=5
linesperpage=data.7
IF FIND(UPPER(data.8),'TERSE')>0 THEN terseflag=1
ELSE terseflag=0
IF FIND(UPPER(data.8),'COLOR')>0 THEN colorflag=1
ELSE colorflag=0
CALL colors(colorflag)
menu='ALL'
IF FIND(UPPER(data.8),'MENUS')>0 THEN
  DO
    menuflag=1
    menu='MAIN'
  END
ELSE IF FIND(UPPER(data.8),'MENU')>0 THEN menuflag=1
ELSE menuflag=0
IF level=0 THEN menu='NEW'
data.21=UPPER(data.21)
maxtime=WORD(data.11,1)*60

loadFriends:
CALL MAKEDIR(bbspath'Friends')
alias.=''
alias.0=0
realname.=''
CALL CLOSE(f)
IF OPEN(f,bbspath'Friends/'name,'R')=0 THEN RETURN 1
DO i=1
  line=READLN(f)
  IF EOF(f) THEN LEAVE i
  alias.i=WORD(line,1)
  realname.i=WORD(line,2)
END
alias.0=i-1
CALL CLOSE(f)
RETURN 1


switchmenuflag:
IF menuflag=1 THEN
  DO
    menuflag=0
    noff='OFF'
  END
ELSE
  DO
    menuflag=1
    noff='ON'
  END
SAY 'Menus turned' pen3||noff||def'.'CR
SAY 'To make a permanent change, add or delete MENU(S) from [Y]our userdata item 8.'CR
RETURN


switchcolors:
IF colorflag=1 THEN
  DO
    colorflag=0
    noff='OFF'
  END
ELSE
  DO
    colorflag=1
    noff='ON'
  END
CALL colors(colorflag)
SAY 'Color turned' pen3||noff||def'.'CR
SAY 'To make a permanent change, add or delete COLOR from [Y]our userdata item 8.'CR
RETURN


/* ANSI pen color codes */
colors:
ARG onoff
IF onoff THEN
  DO
    lineup='1B'x'M'
    def='';  /* default */
    pen0='';  pen1='';  pen2='';  pen3=''
    pen4='';  pen5='';  pen6='';  pen7=''
    bak0='';  bak1='';  bak2='';  bak3=''
    bak4='';  bak5='';  bak6='';  bak7=''
  END
ELSE
  DO
    pen0=''; pen1=''; pen2=''; pen3=''; pen4=''; pen5=''; pen6=''; pen7=''
    bak0=''; bak1=''; bak2=''; bak3=''; bak4=''; bak5=''; bak6=''; bak7=''
    def='';  lineup=''
  END
RETURN


chpro:
arg=UPPER(LEFT(arg,1))
IF(arg='') THEN
  DO
    SAY CR
    SAY '['pen3'W'def']- WXModem'CR
    SAY '['pen3'X'def']- XModem-CRC'CR
    SAY '['pen3'K'def']- XModem-1K'CR
    SAY '['pen3'Y'def']- YModem'CR
    SAY '['pen3'G'def']- YModem-G'CR
    SAY '['pen3'Z'def']- ZModem'CR
    SAY CR
    arg=getinput(1 0 STRIP(protocol) '> ')
 END
IF LEFT(UPPER(arg),1)='A' THEN arg='Z'
Set arg
Status Transfer
protocol=STRIP(RESULT)
SAY protocol||CR
RETURN


sortinfofiles:
infolist=SHOWDIR(bbspath'Information')
IF infolist='' THEN
  DO
    SAY CR
    SAY pen3'No files are currently in the Information drawer.'def||CR
    SAY CR
    RETURN 1
  END
IF ~DATATYPE(sortinfo.0,'W') THEN
  DO
    info.=''
    sortinfo.=''
    info.0=WORDS(infolist)
    DO i=1 TO info.0
      info.i=WORD(infolist,i)
    END
    SAY 'Sorting..'CR
    CALL QSORT(1,info.0,info)
    sortinfo.0=info.0%3
    IF (info.0//3)>0 THEN sortinfo.0=sortinfo.0+1
    DO i=1 TO sortinfo.0
      sortinfo.i=''
      DO j=0 TO 2
        k=i+j*sortinfo.0
        IF k<=info.0 THEN
          DO
            sortinfo.i=sortinfo.i RIGHT(k,3)'.' LEFT(info.k,19)
            infocount=WORD(STATEF(bbspath'Information/'info.k),8)
            sortinfo.i.0=sortinfo.i.0||RIGHT(infocount,5) LEFT(info.k,19)
          END
      END
    END
    SAY lineup'         'lineup||CR
  END
RETURN 0


information:
IF sortinfofiles() THEN RETURN
CALL sound('INFO')
SAY pen3'These text files are available for reading online...'def||CR
num=1
readcount=-1
DO infoloop=1
  IF num=0 THEN
    DO
      IF readcount~=-1 THEN
        DO
          sortinfo.0=''
          IF sortinfofiles() THEN RETURN
        END
      SAY CENTER('- Number of accesses per file -',75)||CR
    END
  SAY pen3||LEFT('-',75,'-')||def||CR
  DO i=1 TO sortinfo.0
    IF num=0 THEN SAY sortinfo.i.0||CR
    ELSE SAY sortinfo.i||CR
  END
  CALL checktime()
  IF num=0 THEN
    DO
      CALL waiting()
      num=1
      ITERATE infoloop
    END
  num=getinput(1 0 pen3'Select Number Of Information File To View. 0=Stats > 'def)
  IF num=0 THEN ITERATE infoloop
  IF ~DATATYPE(num,'W') | num<1 | num>info.0 THEN RETURN
  readcount=STATEF(bbspath'Information/'info.num)
  readbytes=WORD(readcount,2)
  SAY '  'info.num 'is' readbytes 'bytes.'CR
  IF getinput(1 1 '['pen3'R'def']ead or ['pen3'D'def']ownload? (dR) > ')='D' THEN
    DO
      allargs=bbspath'Information/'info.num
      CALL dload2()
    END
  ELSE
    DO
      SAY 'Loading File...'CR
      readcount=WORD(readcount,8)
      IF ~DATATYPE(readcount,'W') THEN readcount=0
      ADDRESS COMMAND 'C:filenote' bbspath'Information/'info.num readcount+1
      CALL DELAY(28)
      CALL readlines(bbspath'Information/'info.num 1)
      CALL cleanline(0)
      SAY lineup'    'lynes.0 'lines.'CR
      SAY CR
      CALL seelines(0)
    END
  CALL showtime()
  IF waitchar~='Q' THEN CALL waiting()
  nonstop=0
END
RETURN


newfiles:
SAY CR
test=''
test=getinput(1 1 'Show one library only? (Ny) > ')
IF test='Y' THEN
  IF chdir()>0 THEN RETURN
SAY 'Searching for new (un-browsed) files since' DATE(,WORD(data.16,2),'S') 'at' WORD(data.16,3)'...'CR
lastbrowz=WORD(data.16,1)
lastfileup=countcheck(bbspath'Numbers/LastFile' 0)

newfiles2:
IF lastbrowz>=lastfileup THEN
  DO
    lastbrowz=0
    SAY pen3'No new files. Listing backwards by date from last file uploaded...'def||CR
  END
ELSE newfilesflag=1
j=0
IF test='Y' THEN
  DO
    filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir))
    CALL busywait(4 1)
  END
DO ni=lastfileup TO lastbrowz+1 BY -1
  IF files.ni~='' THEN
    DO
      IF test='Y' THEN
        DO
          IF ni>1 THEN CALL busywait(60 ni lastfileup-lastbrowz)
          IF j>=filecount THEN LEAVE ni
          IF UPPER(LEFT(WORD(files.ni,1),12))~=UPPER(LEFT(plaindir,12)) THEN
            ITERATE ni
        END
      jj=files.ni.0
      IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(WORD(files.ni,1)))>0 THEN
        ITERATE ni  /* unauthorized */
      IF test='Y' THEN CALL busywait(4 0)
      j=j+1
      IF j=1 THEN CALL fileheader()
      SAY alpha.jj||CR
      IF (j+2)//(linesperpage-1)=0 THEN
        IF waiting2() THEN LEAVE ni
      IF test='Y' THEN CALL busywait(4 1)
    END
END
IF test='Y' THEN CALL busywait(4 0)
IF j//linesperpage~=0 THEN CALL waiting()
IF j=0 & newfilesflag=1 THEN
  DO
    lastbrowz=999999
    newfilesflag=0
    CALL newfiles2()
  END
IF test~='Y' THEN
  DO
    CALL newinfo()
    IF lynes.0>0 THEN CALL waiting()
  END
nonstop=0
RETURN


newinfo:
lynes.=''
lynes.0=0
dm=DATE(,WORD(data.16,2),'S')
PARSE VAR dm da' 'mo' 'yr .
yr=RIGHT(yr,2)
sincedate=da'-'mo'-'yr
startline=1
arg=bbspath'Information'
IF WORD(STATEF(arg),5)>lastondate THEN
  DO
    ADDRESS COMMAND 'C:LIST >ram:dirlist' arg 'NOHEAD DATES SINCE' sincedate
    IF WORD(STATEF('ram:dirlist'),2)>3 THEN
      DO
        lynes.startline=pen1||bak2' New or Updated Information Files. Enter'def pen3'I'def bak2'from the main menu to read 'def
        CALL readlines('ram:dirlist' startline+1)
      END
  END
arg=bbspath'Profiles'
IF level>0 & WORD(STATEF(arg),5)>lastondate THEN
  DO
    ADDRESS COMMAND 'C:LIST >ram:dirlist' arg 'NOHEAD DATES SINCE' sincedate
    IF WORD(STATEF('ram:dirlist'),2)>3 THEN
      DO
        startline=lynes.0+2
        lynes.startline=pen1||bak2' New or Updated User Profiles. Enter'def pen3'&'def bak2'from the main menu to read 'def
        CALL readlines('ram:dirlist' startline+1)
      END
  END
arg=bbspath'rexxDoors/Data/Polls'
IF level>0 & WORD(STATEF(arg),5)>lastondate THEN
  DO
    startline=lynes.0+2
    lynes.startline=pen1||bak2' Voting Activity. Enter'def pen3'J'def bak2'from the main menu, then select Polling_Place 'def
    lynes.0=startline
  END
IF logonflag=1 THEN nonstop=1
IF lynes.0>0 THEN CALL seelines(1)
nonstop=0
RETURN


areaselect:
SAY pen3||LEFT('-',75,'-')||def||CR
DO i=1 TO msgs.0
  SAY msgs.i||CR
  IF i//linesperpage=0 THEN CALL waiting()
END
temp=getinput(1 0 pen3'Select Message Conference: 'def)
IF ~DATATYPE(temp,'W') | temp<1 | temp>level | FIND(data.21,temp)>0 THEN RETURN 1
msgdir=temp
RETURN 0


chdir:
string=''
SAY pen3||LEFT('-',75,'-')||def||CR
DO i=1 TO libs.0
  SAY libs.i||CR
END
dirnum=getinput(1 0 pen3'Select Library Number: 'def)
IF ~DATATYPE(dirnum,'W') THEN
  DO
    waitchar=dirnum
    RETURN 2
  END

chdir2:
IF dirnum<1 | dirnum>99 THEN
  DO
    waitchar=dirnum
    RETURN 1
  END
IF dirs.dirnum='' THEN
  DO
    SAY pen3'That library number is currently un-assigned.'def||CR
    RETURN 1
  END
IF dirnum>level | FIND(data.21,UPPER(dirs.dirnum))>0 THEN
  DO
    SAY pen3'You do not have authorization for that library!'def||CR
    RETURN 1
  END
CALL MAKEDIR(libpath||dirs.dirnum)
CALL setdir(libpath||dirs.dirnum)
t=libpath||plaindir'.txt'
IF ~EXISTS(t) THEN RETURN 0
nonstop=1
SAY CR
CALL readlines(t 1)
CALL seelines(1)
SAY CR
nonstop=0
RETURN 0


since:
dm=DATE(,WORD(data.16,2),'S')
SAY CR
SAY 'New files or files moved since' dm||CR
CALL listsince()
CALL readlines('RAM:dirlist' 1)
CALL seelines(1)
nonstop=0
CALL waiting()
RETURN


listsince:
dm=DATE(,WORD(data.16,2),'S')
PARSE VAR dm da' 'mo' 'yr .
yr=RIGHT(yr,2)
sincedate=da'-'mo'-'yr
ADDRESS COMMAND 'C:list >RAM:dirlist' directory 'DATES SINCE' sincedate
RETURN


list:
onetime=0
IF DATATYPE(arg,'W') THEN onetime=1
ELSE arg=''
DO listloop=1
  IF DATATYPE(arg,'W') THEN
    DO
      dirnum=arg
      arg=''
      IF chdir2()>0 THEN RETURN
      CALL listsimple()
      IF waitchar='Q' | onetime THEN LEAVE listloop
    END
  ELSE IF arg='' THEN
    DO
      IF chdir()>0 THEN RETURN
      test='Y'
      CALL showalpha2()
      arg=''
      IF waitchar='Q' THEN waitchar=''
      IF waitchar~='' THEN RETURN
      ITERATE listloop
    END
  ELSE RETURN
END
RETURN


listsimple:
ADDRESS COMMAND 'C:list >RAM:dirlist' directory 'DATES'
IF readlines('RAM:dirlist' 1) THEN RETURN
IF lynes.0>3 THEN
  DO
    SAY pen3'Sorting...'def||lineup||CR
    linesave=lynes.1  /* these 4 lines put in to leave dir title at top */
    lynes.1='0'
    CALL QSORT(1,lynes.0-1,lynes)
    CALL DELAY(14)
    lynes.1=linesave
  END
CALL seelines(1)
nonstop=0
CALL waiting()
RETURN


browse:
curdironly=0
brdir=PRAGMA('D')
brfilenum=1
nonstop=0
IF files.0<1 THEN RETURN
lastfilenum=countcheck(bbspath'Numbers/LastFile' 0)
IF lastfilenum<1 THEN RETURN
onearg=0
IF arg='' THEN
  DO
    lin='Browsing'
    test=getinput(1 1 'Browse one library only? (Ny) > ')
    IF test='Y' THEN
      DO
        IF chdir()>0 THEN RETURN
        curdironly=1
        lin=lin 'the' pen3||plaindir||def 'library'
        t=libpath||plaindir'.txt'
        IF level>sysoplevel THEN
          IF getinput(1 1 'Edit the'pen3 Plaindir def'library info file? (Ny) > ')='Y' THEN
            DO
              IF ~EXISTS(t) THEN
                DO
                  IF writeopen(t)~=0 THEN
                    DO
                      CALL WRITELN(f,TRIM(CENTER('***' plaindir '***',77)))
                      CALL WRITELN(f,LEFT('',75,'='))
                      CALL CLOSE(f)
                      CALL DELAY(28)
                    END
                END
              CALL bbsED(1 t)
              RETURN
            END
      END
    ELSE lin=lin 'all file libraries'
    lin=lin 'backwards from latest file.'
    SAY lin||CR
    SAY CR
  END
ELSE onearg=1
i=0
IF arg='' | UPPER(arg)='NEW' | UPPER(arg)='ALL' THEN
  DO lastfileloop=1
    IF lastfilenum<1 THEN RETURN
    arg=WORD(files.lastfilenum,2)
    brfilenum=lastfilenum
    IF WORD(files.lastfilenum,2)~='' THEN LEAVE lastfileloop
    lastfilenum=lastfilenum-1
  END
ELSE IF DATATYPE(arg,'W') & files.arg~='' THEN
  DO
    brfilenum=arg
    arg=WORD(files.arg,2)
    IF arg='' THEN
      DO
        SAY 'File number' brfilenum 'does not exist in the current libraries!'CR
        RETURN
      END
  END
ELSE
  DO
    IF onearg THEN CALL busywait(4 1)
    DO ni=lastfilenum TO 1 BY -1
      IF onearg THEN CALL busywait(60 ni lastfilenum)
      IF UPPER(WORD(files.ni,2))~=UPPER(arg) THEN ITERATE ni
      brfilenum=ni
      CALL busywait(4 0)
      LEAVE ni
    END
    IF ni<1 THEN
      DO
        SAY 'Unable to find a file description for' pen3||arg||def'.'CR
        RETURN
      END
  END
IF ~curdironly THEN CALL setdir(libpath||WORD(files.brfilenum,1))
savearg=arg
IF brfilenum>lastfilenum THEN brfilenum=lastfilenum
newfilesdate=DATE('S') TIME()
DO browseloop=1
  IF curdironly THEN CALL busywait(4 1)
  DO ni=brfilenum TO 0 BY -1
    IF ni=0 THEN LEAVE browseloop
    IF files.ni='' THEN ITERATE ni
    IF onearg THEN
      DO
        CALL busywait(60 ni lastfilenum)
        IF UPPER(arg)=UPPER(WORD(files.ni,2)) THEN LEAVE ni
        ELSE ITERATE ni
      END
    testdir=UPPER(WORD(files.ni,1))
    IF curdironly & UPPER(plaindir)~=UPPER(testdir) THEN
      DO
        IF ni>lastbrowse THEN lastbrowse=ni
        IF ni>0 THEN CALL busywait(60 ni lastfilenum)
        ITERATE ni
      END
    IF FIND(data.21,testdir)>0 | finddirnum(testdir)>level THEN
      DO
        IF ni>lastbrowse THEN lastbrowse=ni
        ITERATE ni
      END
    LEAVE ni
  END
  IF curdironly | onearg THEN CALL busywait(4 0)
  onearg=0
  IF ni=0 THEN brfilenum=lastbrowse
  ELSE brfilenum=ni
  argname=WORD(files.brfilenum,2)
  IF argname='' THEN RETURN
  CALL setdir(libpath||WORD(files.brfilenum,1))
  arg=bbspath'FileNotes/'plaindir'/'argname
  CALL readlines(arg 1)
  IF nonstop=1 THEN brostop=1
  ELSE brostop=0
  CALL seelines(1)
  IF brfilenum>lastbrowse THEN lastbrowse=brfilenum
  CALL checktime()
  IF brostop THEN
    DO
      SAY CR
      nonstop=1
      brfilenum=brfilenum-1
    END
  ELSE
    DO
      line=''
      endtest=UPPER(RIGHT(argname,4))
      IF FIND('.ARC .ARJ .DMS .LZH .LHA .RUN .ZIP .ZOO',endtest)>0 THEN
        line='['pen3'C'def']ontents ['pen3'D'def']ownload'
      ELSE line='['pen3'D'def']ownload'
      IF level>sysoplevel | name=WORD(lynes.3,2) THEN
        line=line '['pen3'E'def']dit'
      IF level>sysoplevel | name=WORD(lynes.3,2) THEN
        line=line '['pen3'K'def']ill'
      IF level>sysoplevel THEN line=line '['pen3'L'def']ib'
      line=line '['pen3'M'def']ark ['pen3'N'def']on-Stop'
      IF endtest='.TXT' THEN line=line '['pen3'R'def']ead'
      line=line '['pen3'Q'def']uit ['pen3'?'def'] > '
      brcom=getinput(1 0 line)
      IF DATATYPE(brcom,'W') THEN
        DO
          brfilenum=brcom+1
          IF brfilenum>lastfilenum THEN brfilenum=lastfilenum+1
          IF brfilenum<1 THEN brfilenum=1
          SAY CR
        END
      ELSE brcom=LEFT(brcom,1)
      CALL cleanline(0)
      IF brcom='Q' THEN LEAVE browseloop
      IF brcom='M' THEN
        DO
          wordnum=FIND(data.25,brfilenum)
          IF wordnum=0 THEN
            DO
              data.25=STRIP(data.25 brfilenum)
              SAY lineup||argname 'marked for next download.'CR
              SAY CR
            END
          ELSE
            DO
              data.25=STRIP(DELWORD(data.25,wordnum,1))
              SAY argname 'removed from download list.'CR
            END
        END
      IF brcom='H' | brcom='?' THEN
        DO
          SAY pen3' - HELP with the Browse Files commands -'def||CR
          SAY ' RETURN reads the next file description in line.'CR
          SAY ' 34 will display the description of file number 34, if it exists.'CR
          SAY ' C  displays the contents of an archived (arc dms lzh lha zip zoo) file.'CR
          SAY ' D  displays the download menu.'CR
          IF level>sysoplevel | name=WORD(lynes.3,2) THEN
            DO
          SAY ' E  puts this file description into the online Editor.'CR
          SAY ' K  deletes a file you uploaded. you cannot Kill others!'CR
            END
          IF level>sysoplevel THEN
          SAY ' L  move file and description to new Library and/or rename.'CR
          SAY ' M  mark/unmark the current file for the next download'CR
          SAY ' N  displays all descriptions without pausing. CTRL-E to Exit!'CR
          SAY ' R  displays file as text. - ONLY FILES THAT END IN .TXT -'CR
          SAY ' Q  returns to the main menu(s). (Quit)'CR
          SAY CR
          CALL waiting()
          IF waitchar='Q' THEN LEAVE browseloop
        END
      ELSE IF brcom='L' & level>sysoplevel THEN
        DO
          curdir=PRAGMA('D')
          IF getinput(1 1 'Rename' argname '? (Ny) > ')='Y' THEN
            DO
              newarg=getinput(0 0 'Rename' argname 'to ')
              IF newarg~='' THEN
                DO
                  IF is_here(newarg) THEN ITERATE browseloop
                  IF wi=999999 THEN ITERATE browseloop
                  IF EXISTS(libpath||filedir'/'newarg) THEN
                    DO
                      SAY CR
                      SAY '***' newarg 'already exists!'CR
                      SAY CR
                      ITERATE browseloop
                    END
                  junk=getinput(1 1 'Are you SURE you want to rename' argname 'to' newarg'? (Ny) ')
                  IF junk='Y' THEN
                    DO
                      lynes.2=OVERLAY(newarg,lynes.2,7,25)
                      comment=WORD(STATEF(arg),8)
                      CALL DELETE(arg)
                      arg=bbspath'FileNotes/'plaindir'/'newarg
                      CALL savelines(arg)
                      IF comment='' THEN
                        DO
                          mpath=libpath||plaindir
                          IF RENAME(mpath'/'argname,mpath'/'newarg)=0 THEN
                            SAY 'Rename failed on main file!'CR
                        END
                      ELSE
                        DO
                          t=LASTPOS('/',comment)
                          IF t=0 THEN t=LASTPOS(':',comment)
                          mpath=LEFT(comment,t-1)
                          IF RENAME(comment,mpath'/'newarg)=1 THEN
                            ADDRESS COMMAND 'C:FileNote' arg mpath'/'newarg
                          ELSE SAY 'Rename failed on external file!'CR
                        END
                      files.brfilenum=STRIP(WORD(files.brfilenum,1)) newarg
                      anum=files.brfilenum.0
                      alpha.anum=OVERLAY(newarg,alpha.anum,1,WORDINDEX(alpha.anum,2)-2)
                      CALL send2log('RENAME:' argname 'to' newarg 'in' plaindir)
                      argname=newarg
                      sortalphaflag=1
                      savefileflag=1
                    END
                END
            END
          mvdir=getinput(0 0 'Move' argname 'to Library (name|number) ')
          IF mvdir~='' THEN
            DO
              IF DATATYPE(mvdir,'W') THEN
                DO
                  dirnum=mvdir
                  IF UPPER(dirs.dirnum)~=UPPER(WORD(files.brfilenum,1)) THEN
                    DO
                      IF chdir2()=0 THEN
                        DO
                          CALL readlines(arg 1)
                          CALL movefile(brfilenum dirs.dirnum)
                        END
                    END
                END
              ELSE
                DO
                  mvdir=STRIP(mvdir)
                  IF UPPER(mvdir)~=UPPER(WORD(files.brfilenum,1)) THEN
                    DO
                      DO mj=1 TO level+1
                        IF UPPER(mvdir)=UPPER(dirs.mj) THEN LEAVE mj
                      END
                      IF mj<=level THEN CALL movefile(brfilenum mvdir)
                    END
                END
            END
          IF savefileflag>0 THEN CALL savefilelist()
          CALL setdir(curdir)
        END
      ELSE IF brcom='N' THEN
        DO
          brfilenum=brfilenum-1
          nonstop=1
          SAY pen3'To EXIT non-stop scrolling of text, press CTRL-E'def||CR
          SAY CR
          CALL DELAY(100)
          brcom=''
        END
      ELSE IF brcom='C' THEN
        DO
          temp=STRIP(WORD(STATEF(arg),8))
          IF temp='' THEN temp=libpath||plaindir'/'argname
          CALL Contents.rexx(temp)
          IF EXISTS('RAM:CONTENTS') THEN
            DO
              CALL cleanline(1)
              CALL readlines('RAM:CONTENTS' 1)
              CALL seelines(0)
              IF waitchar~='Q' THEN CALL waiting()
              nonstop=0
            END
          ELSE SAY pen3'Not an archived file.'def||CR
        END
      ELSE IF brcom='D' THEN
        DO
          arg2=arg
          arg=brfilenum
          CALL dload()
          arg=arg2
        END
      ELSE IF brcom='E' THEN
        DO
          IF level>sysoplevel | name=WORD(lynes.3,2) THEN
            DO
              firstedit=5
              IF level>sysoplevel THEN firstedit=1
              CALL bbsED(firstedit arg)
            END
        END
      ELSE IF brcom='K' THEN
        DO
          IF level>sysoplevel | name=WORD(lynes.3,2) THEN
            DO
              IF getinput(1 1 pen3'Do you really want to kill this file? (nY) >'def)~='N' THEN
                DO
                  tempnum=WORD(lynes.1,2)
                  IF tempnum=lastfilenum THEN
                    DO
                      CALL DELETE(bbspath'Numbers/LastFile')
                      CALL DELAY(28)
                      lastfilenum=lastfilenum-1
                      CALL countcheck(bbspath'Numbers/LastFile' lastfilenum)
                    END
                  files.tempnum=''
                  tempnum2=files.tempnum.0
                  alpha.tempnum2='0 0' tempnum '100'
                  IF SHOW('P','BBBBS_LOCAL') THEN CALL savefilelist()
                  ELSE savefileflag=1
                  finfo=STATEF(arg)
                  IF WORDS(finfo)>7 THEN argname=WORD(finfo,8)
                  CALL DELETE(argname)
                  CALL DELETE(arg)
                  CALL send2log('Killed:' argname)
                  SAY argname pen3'has been deleted.'def||CR
                END
            END
        END
      ELSE IF brcom='R' & endtest='.TXT' THEN
        DO
          vcount=WORD(lynes.2,7)+1
          lynes.2=STRIP(DELWORD(lynes.2,7,1)) vcount
          edtype=''
          CALL savelines(arg)
          CALL showtext(argname)
        END
      ELSE brfilenum=brfilenum-1
    END
END
CALL setdir(brdir)
waitchar=''
IF nonstop THEN CALL waiting()
nonstop=0
CALL savedata(0)
RETURN


movefile:
PARSE ARG fnum movdir .
fromdir=STRIP(WORD(files.fnum,1))
farg=STRIP(WORD(files.fnum,2))
CALL MAKEDIR(libpath||movdir)
ADDRESS COMMAND 'C:COPY' libpath||fromdir'/'farg libpath||movdir
IF EXISTS(libpath||movdir'/'farg) THEN CALL DELETE(libpath||fromdir'/'farg)
files.fnum=movdir farg
lynes.3=DELWORD(lynes.3,WORDS(lynes.3),1)
lynes.3=STRIP(lynes.3) movdir
CALL MAKEDIR(bbspath'FileNotes/'movdir)
CALL savelines(bbspath'FileNotes/'movdir'/'farg)
ndx=files.fnum.0
dnum=finddirnum(movdir)
alpha.ndx=OVERLAY(RIGHT(dnum,2) movdir,alpha.ndx,31,15)
IF EXISTS(bbspath'FileNotes/'movdir'/'farg) THEN
  DO
    temp=bbspath'FileNotes/'fromdir'/'farg
    comment=WORD(STATEF(temp),8)
    CALL DELETE(temp)
    IF comment~='' THEN
      ADDRESS COMMAND 'C:FileNote' bbspath'FileNotes/'movdir'/'farg comment
  END
savefileflag=1
line='Moved:' fromdir'/'farg 'to' movdir
CALL send2log(line)
SAY line||CR
RETURN


textsearch:
PARSE ARG sfile' 'sarg
IF sarg='' THEN RETURN 0
x=OPEN(f,sfile,'R')
IF x=0 THEN RETURN 0
sarg=UPPER(sarg)
stemp=UPPER(READCH(f,65000))
CALL CLOSE(f)
retflag=0
IF POS(sarg,stemp)>0 THEN retflag=1
DROP stemp
RETURN retflag


bbsSEARCH:
smenu=menu
test=UPPER(LEFT(arg,1))
IF test='F' THEN smenu='FILE'
IF test='M' THEN smenu='MSG'
IF test='U' THEN smenu='MAIN'
IF smenu='ALL' THEN
  DO
    junk=getinput(1 1 'Search ['pen3'F'def']iles ['pen3'M'def']essages or ['pen3'U'def']sers (fmu) > ')
    IF junk='F' THEN smenu='FILE'
    ELSE IF junk='M' THEN smenu='MSG'
    ELSE IF junk='U' THEN smenu='MAIN'
    ELSE RETURN
  END
IF WORDS(arg)>1 THEN searcharg=UPPER(SUBSTR(arg,WORDINDEX(arg,2)))
ELSE searcharg=getinput(0 0 pen3'Search Phrase: 'def)
IF LENGTH(STRIP(searcharg))=0 THEN RETURN
searcharg=COMPRESS(searcharg,'*')
CALL send2log('SEARCH:' smenu 'for' searcharg)
IF smenu='NEW' | smenu='MAIN' THEN
  DO
    SAY 'Searching Userlist...'CR
    DO i=1 TO WORDS(userlist)
      IF POS(UPPER(searcharg),UPPER(WORD(userlist,i)))>0 THEN
        SAY WORD(userlist,i)||CR
    END
  END
IF smenu='MSG' THEN
  DO
    IF getinput(1 1 'Search one conference only? (Ny) > ')='Y' THEN
      DO
        IF areaselect() THEN RETURN
        SAY 'Searching' msg.msgdir 'Message Conference for'pen3 searcharg||def'...'CR
        SAY CR
        CALL searchmsgdir()
      END
    ELSE
      DO
        SAY 'Searching All Public Message Conferences for'pen3 searcharg||def'...'CR
        SAY CR
        DO i=1 TO level
          msgdir=i
          IF msg.msgdir='' | FIND(data.21,msgdir)>0 THEN ITERATE i
          CALL searchmsgdir()
          i=msgdir
          IF msgcom='Q' THEN i=999999
        END
      END
  END
IF smenu='FILE' THEN
  DO
    line=pen3'Searching'
    curdironly=0
    IF getinput(1 1 'Search one library only? (Ny) > ')='Y' THEN
      DO
        IF chdir()>0 THEN RETURN
        curdironly=1
        line=line 'the' pen3||plaindir||def 'library'
        SAY CR
      END
    ELSE
      DO
        line=line 'all file libraries'
        SAY CR
        SAY pen3'WARNING!'def 'Searching' RIGHT(files.0,5) '['pen3'F'def']ull descriptions may take'pen3 TRUNC(files.0/(114*cpu)+.05,1) def'minutes!'CR
      END
    test=getinput(1 1 '   ['pen3'A'def']lphaList search or ['pen3'F'def']ull descriptions? (Afq) > ')
    IF test='Q' THEN RETURN
    SAY CR
    SAY line 'for'def UPPER(searcharg)||CR
    SAY pen3' - To ABORT, press CTRL-E -'def||CR
    SAY CR
    IF test~='F' THEN
      DO
        CALL fileheader()
        DO i=1 TO alpha.0
          CALL busywait(60 i alpha.0)
          ii=WORD(alpha.i,4)
          IF ii>level THEN ITERATE i
          IF curdironly=1 & ii~=dirnum THEN ITERATE i
          ii=WORD(alpha.i,3)
          IF POS(UPPER(WORD(files.ii,1)),data.21)>0 THEN ITERATE i
          tempnum=POS(UPPER(searcharg),UPPER(alpha.i))
          IF tempnum>0 THEN
            DO
              CALL busywait(4 0)
              SAY alpha.i||CR
              IF colorflag=1 THEN
                SAY pen3||LEFT(' ',tempnum-1)||lineup||UPPER(searcharg)||def||CR
              CALL busywait(4 1)
            END
        END
      END
    ELSE
      DO
        cck=countcheck(bbspath'Numbers/LastFile' 0)
        nonstop=1
        DO i=1 TO cck
          iii=cck+1-i
          IF files.iii='' THEN ITERATE i
          ii=files.iii.0
          ii=WORD(alpha.ii,4)
          IF ii>level THEN ITERATE i
          IF curdironly=1 & ii~=dirnum THEN ITERATE i
          IF POS(UPPER(WORD(files.iii,1)),data.21)>0 THEN ITERATE i
          farg=WORD(files.iii,1)'/'WORD(files.iii,2)
          SAY '1B'x'M' RIGHT(farg,40) LEFT(iii,7)||CR
          IF textsearch(bbspath'FileNotes/'farg searcharg) THEN
            DO
              savei=i
              CALL readlines(bbspath'FileNotes/'farg 1)
              CALL seelines(2)
              i=savei
              SAY CR
              SAY CR
            END
        END
      END
    CALL busywait(4 0)
  END
searcharg=''
nonstop=0
SAY CR
IF i<999999 THEN SAY 'All available items have been searched.'CR
SAY CR
CALL waiting()
RETURN


searchmsgdir:
msglist=SHOWDIR(msgpath||msgdir)
IF WORDS(msglist)>0 THEN SAY lineup||RIGHT(msg.msgdir,40)||CR
qi=WORDS(msglist)
DO wi=1 TO qi
  CALL busywait(8 wi qi)
  messnum=WORD(msglist,wi)%1
  IF textsearch(msgpath||msgdir'/'messnum searcharg) THEN
    DO
      CALL busywait(4 0)
      savelast=lastread.msgdir
      CALL readmsg(0 messnum)
      lastread.msgdir=savelast
      IF msgcom='Q' THEN RETURN
      CALL busywait(4 1)
    END
END
CALL busywait(4 0)
RETURN


finddirnum:
ARG fdirname .
DO fdir=1 TO 99
  IF UPPER(dirs.fdir)=UPPER(fdirname) THEN RETURN fdir
END
RETURN 100


writebuffer:
PARSE ARG bufname .
Capture OFF
CALL DELETE(bufname)
SAY 'Type 'pen3'/E'def' or 'pen3'/S'def' on a new line to Exit and Save.'CR
IF EXISTS(bufname) THEN
  DO
    CALL DELAY(56)
    CALL DELETE(bufname)
    CALL DELAY(56)
  END
CaptWrap 74
Send pen3
Capture bufname
Send def
TimeOut 120
DO bufloop=1
  Wait '/E,/S,RING,NO CARRIER'
  Status 'L'
  test=LEFT(UPPER(cleanstring(0':'RESULT)),2)
  CALL checkdcd()
  IF test='/E' | test='/S' THEN LEAVE bufloop
END
Send '\b\b'pen3
Capture OFF
CALL checkdcd()
TimeOut maxidle
SAY def||CR
startnum=lynes.0+1
CALL readlines(bufname startnum)
CALL wrapbuf(startnum)
QUEUE CR
RETURN


wrapbuf:
ARG startnum .
CALL cleanline(1)
SAY pen3'Wordwrapping...'def||CR
lynes.startnum=TRANSLATE(lynes.startnum,' ','09'x)
lynes.startnum=cleanstring(2':'lynes.startnum)
DO wi=startnum WHILE wi<=lynes.0
  wj=wi+1
  lynes.wj=TRANSLATE(lynes.wj,' ','09'x)
  lynes.wj=cleanstring(2':'lynes.wj)
  IF LENGTH(lynes.wi)>75 THEN
    DO
      testchar=''
      IF lynes.wj~='' THEN testchar=LEFT(lynes.wj,1)
      IF testchar=' ' | testchar='.' | testchar=':' THEN
        DO
          DO wjj=lynes.0 TO wi+1 BY -1
            wk=wjj+1
            lynes.wk=lynes.wjj
          END
          lynes.wj=''
          lynes.0=lynes.0+1
        END
      DO wl=WORDS(lynes.wi) TO 1 BY -1 WHILE LENGTH(lynes.wi)>74
        IF WORDS(lynes.wi)=1 THEN
          lynes.wi=LEFT(lynes.wi,74) SUBSTR(lynes.wi,75)
        lynes.wj=WORD(lynes.wi,wl) lynes.wj
        lynes.wi=STRIP(DELWORD(lynes.wi,wl,1))
      END
    END
END
RETURN


seelines:
ARG fancy .
DO i=1 TO lynes.0
  IF fancy=0 THEN SAY lynes.i||def||CR
  ELSE
    DO
      IF LEFT(lynes.i,2)=': ' & WORDS(lynes.i)=2 THEN ITERATE i
      ELSE IF LEFT(lynes.i,10)='Directory ' | LEFT(lynes.i,5)='=====' THEN
        SAY pen3||lynes.i||def||CR
      ELSE SAY lynes.i||CR
      IF fancy=2 & colorflag=1 & searcharg~='' THEN
        DO
          testpos=POS(UPPER(searcharg),UPPER(lynes.i))
          IF testpos>0 THEN
            SAY LEFT(' ',testpos-1)||pen3||lineup||UPPER(searcharg)||def||CR
        END
    END
  IF i//linesperpage=0 THEN
    IF waiting2() THEN LEAVE i
END
nonstop=0
RETURN


readlines:
CALL CLOSE(f)
PARSE ARG tempname readstart .
IF ~readopen(tempname) THEN RETURN 1
IF readstart<2 THEN lynes.=''
DO ri=readstart
  line=READLN(f)
  IF EOF(f) THEN BREAK
  lynes.ri=line
END
lynes.0=ri-1
CALL CLOSE(f)
DO ri=lynes.0 TO 0 BY -1 WHILE LENGTH(lynes.ri)=0 | LEFT(UPPER(lynes.ri),2)='/E' | LEFT(UPPER(lynes.ri),2)='/S'
END
lynes.0=ri
RETURN 0


savelines:
PARSE ARG tempname .
IF EXISTS(tempname) & edtype='MAIL' THEN
  DO
    ok=OPEN(f,tempname,'A')
    IF ok~=0 THEN CALL WRITELN(f,LEFT('',74,'^'))
  END
ELSE ok=OPEN(f,tempname,'W')
IF ok=0 THEN
  DO
    line='***' tempname 'failed to open for saving!'
    CALL send2log(line)
    SAY line||CR
    RETURN 1
  END
DO wi=1 TO lynes.0
  CALL WRITELN(f,lynes.wi)
END
CALL CLOSE(f)
RETURN 0


loaduserlist:
userlist=SHOWDIR(bbspath'Users')
ulynes.=''
IF ~EXISTS(bbspath'Lists/USERS') THEN CALL sortuserlist()
ELSE IF readopen(bbspath'Lists/USERS') THEN
  DO
    SAY 'Loading Userlist...'CR
    DO lui=1
      line=READLN(f)
      IF EOF(f) THEN BREAK
      ulynes.lui=line
    END
    ulynes.0=lui-1
    CALL CLOSE(f)
  END
RETURN


saveuserlist:
SIGNAL OFF BREAK_E
IF writeopen(bbspath'Lists/USERS') THEN
  DO
    DO i=1 TO ulynes.0
      CALL WRITELN(f,ulynes.i)
    END
    CALL CLOSE(f)
  END
RETURN


sortuserlist:
SAY 'Rebuilding Userlist...'CR
sortuserflag=0
userlist=SHOWDIR(bbspath'Users')
user.=''
users=WORDS(userlist)
user.0=users
DO uli=1 TO users
  user.uli=WORD(userlist,uli)
  uscore=LASTPOS('_',user.uli)
  IF uscore>0 THEN user.uli=SUBSTR(user.uli,uscore+1)'@'LEFT(user.uli,uscore-1)
END
CALL QSORT(1,users,user)
DO uli=1 TO users
  uscore=POS('@',user.uli)
  IF uscore>0 THEN user.uli=SUBSTR(user.uli,uscore+1)'_'LEFT(user.uli,uscore-1)
END
ulynes.=''
ulynes.0=user.0%3
IF (user.0//3)>0 THEN ulynes.0=ulynes.0+1
DO i=1 TO ulynes.0
  ulynes.i=LEFT(user.i,25)
  DO j=1 TO 2
    k=i+j*ulynes.0
    IF k<=users THEN ulynes.i=ulynes.i' 'LEFT(user.k,25)
  END
END
CALL saveuserlist()
RETURN


showuserlist:
IF data.5='' THEN line='Here are the EMail names of your fellow users.'
ELSE line='   'WORDS(userlist) 'users. Use these names to address messages.'
SAY pen3||line||def||CR
DO uli=1 TO ulynes.0
  SAY ulynes.uli||CR
  IF uli//linesperpage=0 & uli<ulynes.0 THEN
    IF waiting2()=1 THEN RETURN
END
IF data.5~='' THEN CALL waiting()
RETURN


msgcount:
ARG countdir .
lastmess=0
totmsgs=0
unred=0
IF ~EXISTS(msgpath||countdir) THEN RETURN
IF STATEF(msgpath||countdir)=msg.countdir.1 THEN totmsgs=msg.countdir.0
ELSE
  DO
    totmsgs=WORDS(SHOWDIR(msgpath||countdir))
    msg.countdir.0=totmsgs
    msg.countdir.1=STATEF(msgpath||countdir)
  END
IF countdir>level | FIND(data.21,i)>0 THEN RETURN
lastread.countdir=WORD(data.22,countdir)
IF ~DATATYPE(lastread.countdir,'W') THEN lastread.countdir=0
lastmess=countcheck(bbspath'Numbers/LastMessage'countdir 0)
IF lastread.countdir<0 THEN RETURN
firstmess=countcheck(bbspath'Numbers/FirstMessage'countdir 0)
IF lastread.countdir<firstmess THEN lastread.countdir=firstmess-1
IF lastmess>0 THEN
  IF lastread.countdir>=0 THEN
    DO
      IF lastread.countdir<(firstmess-1) THEN lastread.countdir=firstmess-1
      unred=lastmess-lastread.countdir
      IF unred>totmsgs THEN unred=totmsgs
      cline=RIGHT(unred,6) 'unread of' RIGHT(lastmess,6)
      cline=cline 'messages in the 'CENTER(msg.countdir,20)' conference.'
      IF unred>0 | ~logonflag THEN SAY pen6||cline||def||CR
    END
RETURN


counts:
SAY CR
SAY 'Working...'CR
SAY CR
temp=''
DO i=1 TO 4
  temp=temp||CENTER(copyright.i,75)||'0D0A'x
END
CALL SETCLIP('BBS_copyright',temp||CR)
CALL bbsSTATS.rexx(name colorflag 0 emailonline grand grand2 files.0 WORDS(userlist))
SAY CR
CALL waiting2()
IF waitchar='Q' THEN RETURN
CALL showmarked(1)
CALL logonstats()
nonstop=0
CALL waiting()
RETURN


countmail:
SAY '   Counting online email...'lineup||CR
emailonline=0
DO ti=1 TO WORDS(userlist)
  emailonline=emailonline+WORDS(SHOWDIR(bbspath'Email/'WORD(userlist,ti)))
END
SAY lineup'       'emailonline' letters online.'CR
RETURN


hourly:
IF level=99 & nonstop~=1 THEN
  DO
    IF getinput(1 1 'Zero The Hourly Averages? (Ny) > ')='Y' THEN
      ADDRESS COMMAND 'C:Delete >*' bbspath'Numbers/Hourly/#?'
    CALL cleanline(1)
  END
CALL ShowHourly.rexx(name linesperpage colorflag nonstop)
RETURN


logonstats:
IF level=0 THEN RETURN
SAY bak2||name||def 'Last on' DATE('W',lastondate,'I') DATE(,lastondate,'I') lastontime||CR
tempnum=countcheck(bbspath'Numbers/LastFile' 0)-lastbrowse
IF tempnum>files.0 THEN tempnum=files.0
line='of' RIGHT(countcheck(bbspath'Numbers/LastFile' 0),6) 'public files uploaded.'CR
IF tempnum>0 THEN SAY RIGHT(tempnum,6) '   new of' RIGHT(files.0,6) 'files online    'line
ELSE SAY '       No new' line
totmsg=0
grand=0
grand2=0
DO i=1 TO 99
  IF msg.i='' THEN ITERATE i
  CALL msgcount(i)
  totmsg=totmsg+unred
  grand=grand+totmsgs
  grand2=grand2+lastmess
END
line=RIGHT(grand2,6) 'public messages written'
IF totmsg>0 THEN
  SAY RIGHT(totmsg,6) '   new of' line',' grand 'messages still online.'CR
ELSE SAY '       No new of' line'.'CR

callsleft:
test=WORD(data.11,3)
IF test<1 THEN
  DO
    IF DATE('S')=WORD(data.13,1) THEN
      DO
        line=pen0||bak1' Attention! 'def 'This is your last call for'
        line=line DATE('W')',' DATE()
      END
    ELSE line='It''s after midnight here, you may call' bbsprefs.16 'more times today.'
  END
ELSE
  DO
    line='You may call' test 'more time'
    IF test~=1 THEN line=line's'
    line=line 'today.'
  END
SAY line||CR
RETURN


checkdcd:
IF GETCLIP('BBS_interpret')='' THEN
  DO
    dcd
    IF RC=0 THEN
      DO
        DO dcds=1 TO 3  /* 5 second delay */
          CALL DELAY(50)
          dcd
          IF RC~=0 THEN RETURN
        END
        dcd
        IF RC=0 THEN
          DO
            SAY CR
            Capture OFF
            Remote OFF
            CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
            line='^^^^^ LOST CARRIER! ^^^' DATE() TIME() '^^^^^'
            SAY line||CR
            Send '\dATH1\r'
            CALL send2log(line)
            CALL sound('LOST')
            IF newpassword='' THEN SIGNAL DONE
            ELSE SIGNAL OUT
          END
      END
  END
CALL checkexternal()
RETURN


sound:
ARG snd
IF bbsprefs.13=1 THEN RETURN
ADDRESS AREXX bbsSounds.rexx bbspath'Sounds/' snd
RETURN


checkexternal:
xmsg=GETCLIP('BBS_MESSAGE')
Capture
IF RC=0 & xmsg~='' THEN
  DO
    SAY CR
    SAY bak2' Message From BBBBS: 'def||CR
    SAY xmsg||CR
    SAY CR
    CALL SETCLIP('BBS_MESSAGE')
  END
xstring=GETCLIP('BBS_interpret')
IF xstring~='' THEN
  DO
    CALL SETCLIP('BBS_interpret')
    INTERPRET xstring
  END
xcom=GETCLIP('BBS_COMMAND')
IF xcom~='' THEN
  DO
    CALL SETCLIP('BBS_COMMAND')
    IF POS('G',xcom)>0 THEN SIGNAL LOGOUT2
    IF opt~='' THEN
      DO
        IF POS('B',xcom)>0 THEN test='/E'
        IF POS('L',xcom)>0 THEN CALL uplevel()
        IF POS('M',xcom)>0 THEN CALL validate('DEF.MEMBER')
        IF POS('R',xcom)>0 THEN CALL upratio()
        IF POS('T',xcom)>0 THEN CALL uptime()
        IF POS('V',xcom)>0 THEN CALL validate('DEF.CBV')
      END
    IF POS('C',xcom)>0 THEN CALL chat()
  END
RETURN


chat:
chatrequest=0
chattime=TIME('E')
SAY 'Entering chat mode with sysop.'CR
MSG pen3'- Press backslash [\] to exit -'def
SAY 'Press [RETURN] twice to tell' sysop 'you are finished typing.'CR
SAY CR
OPTIONS PROMPT ''
string=''
DO WHILE(string~='\')
  PULL string
  CALL checkdcd()
END
maxtime=maxtime+(TIME('E')-chattime)%1
RETURN


readopen:
PARSE ARG fname
ok=OPEN(f,fname,'R')
IF ok~=0 THEN RETURN 1
line=fname 'failed to open for reading!'
SAY line||CR
CALL send2log(line)
RETURN 0


writeopen:
PARSE ARG fname
CALL CLOSE(f)
ok=OPEN(f,fname,'W')
IF ok~=0 THEN RETURN 1
line=fname 'failed to open for writing!'
SAY line||CR
CALL send2log(line)
RETURN 0


set_grand:
SAY 'Setting up public message conferences...'CR
grand=0
DO i=1 TO 99
  IF msg.i='' THEN ITERATE i
  msg.i.0=WORDS(SHOWDIR(msgpath||i,'F'))
  msg.i.1=STATEF(msgpath||i)
  grand=grand+msg.i.0
END
RETURN


checkstats:          /* clip is set and cleared by stats programs */
IF TIME('H')>3 & GETCLIP('BBS_STAT')='' THEN
  DO
    IF EXISTS(bbspath'Information/STATS.ULDL') THEN
      DO
        lfinfo=STATEF(bbspath'Information/STATS.ULDL')
        IF WORD(lfinfo,5)<DATE('I') THEN
          DO
            ADDRESS AREXX bbsULDL.rexx
            CALL DELAY(100)
          END
      END
    IF TIME('H')>4 & GETCLIP('BBS_STAT')='' & EXISTS(bbspath'Information/STATS.USER') THEN
      DO
        ufinfo=STATEF(bbspath'Information/STATS.USER')
        IF WORD(ufinfo,5)<DATE('I') THEN
          DO
            ADDRESS AREXX bbsUSER.rexx
            CALL DELAY(100)
          END
      END
    IF grand>SYSTEM_MSG_LIMIT & TIME('H')>5 & TIME('H')<9 & GETCLIP('BBS_STAT')='' THEN
      DO
        SAY 'Doing Message Conference Maintenence...'CR
        Send 'ATH1\r'
        CALL bbsMAINT.baud(SYSTEM_MSG_LIMIT sysop)
        CALL set_grand()
        Send 'ATZ\r'
      END
  END
RETURN


zerovars:
lastread.=0
totwrit.=0
data.=''
libs.=''
smsg.=''
msgs.=''
sdirs.=''
pasted.=''
pasted.0=0
clear_marked=0
sortalphaflag=0
savefileflag=0
sortuserflag=0
linesperpage=22
chatrequest=0
lastbrowse=0
buildalpha=0
terseflag=0
warnings=0
winnings=0
menuflag=0
nonstop=0
dirnum=1
msgdir=1
level=0
newfilesflag=0
newfilesdate=''
newpassword=''
replymsg=''
waitchar=''
string=''
name=''
city='?'
opt=''
RETURN


SYNTAX:
FAILURE:
lin.1=pen7||ERRORTEXT(RC)||def
lin.2=SIGL-1     SOURCELINE(SIGL-1)
lin.3=SIGL pen7||SOURCELINE(SIGL)||def
lin.4=SIGL+1     SOURCELINE(SIGL+1)
DO er=1 TO 4
  IF level>sysoplevel THEN SAY lin.er||CR
  CALL send2log(lin.er)
END
CALL CLOSE(f)
IF newpassword='' THEN SIGNAL DONE  /* no user logged on, quit quietly */
SAY CR
CALL checkdcd()
waitchar=''
IF data.1~='' & data.5~='' & data.20~='' THEN CALL savedata(0)
SIGNAL RESTART


BREAK_E:
CALL CLOSE(f)
SAY pen3'*** CTRL-E BREAK ***'def||CR
waitchar=''
string=''
nonstop=0
rnonstop=0
brostop=0
i=999999
wi=999999
ui=999999
ni=-1
QUEUE CR
RETURN 0


HALT:
BREAK_C:
SIGNAL OFF BREAK_C
SIGNAL OFF BREAK_E
CALL CLOSE(f)
IF newpassword='' THEN
  DO
    CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
    SIGNAL DONE  /* no user logged on, quit quietly */
  END
CALL checkdcd()
SAY CR
IF warnings<1 THEN  /* just 1 warning */
  DO
    warnings=warnings+1
    SAY CR
    SAY CR
    SAY CR
    SAY 'If you didn''t press CTRL-C then...   HEY!    Wake up!'CR
    SAY '                                     Auto-disconnect in' TRUNC(maxidle/60+.5) 'minutes!'CR
    SAY CR
    SAY 'If you DID press CTRL-C,  PLEASE  use CTRL-E next time instead.'CR
    SAY CR
    Remote OFF
    Send '^G\w^G\w^G^G^G^G'
    Remote ON
    waitchar=''
    string=''
    nonstop=0
    CALL SETCLIP('BBS_door')
    SIGNAL ON BREAK_C
    CALL waiting()
    SIGNAL RESTART
  END
CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
SAY 'No Activity For' TRUNC(maxidle/30+.5) 'minutes! -- Disconnecting.'CR
Send '\d'
CALL sound('TIMEOUT')
SIGNAL OUT

LOGOUT:
junk=getinput(1 1 pen3'Leave Feedback for SysOp? (Ny) > 'def)
IF junk='Y' THEN
  DO
    opt='C'  /* to trigger Feedback as Subject */
    CALL editor('MAIL' sysop)
  END

LOGOUT2:
CALL checkexternal()
SIGNAL OFF BREAK_E
CALL SETCLIP('BBS_level')
CALL callsleft()
secs=TIME('E')
mins=secs%60
secs=TRUNC(secs//60)
IF secs<10 THEN secs='0'secs
SAY
SAY 'Public  files   online: 'RIGHT(comma(files.0),9)||CR
SAY 'Public messages online: 'RIGHT(comma(grand),9)||CR
SAY CR
SAY 'Time used this call:' mins':'secs||CR
SAY 'Goodbye' name', thank you for calling' bbsname'.'CR
linesperpage=99
arg=bbspath'BBS_TEXT/GOODBYE'
IF EXISTS(arg) THEN
  DO
    CALL DELAY(14)
    CALL readlines(arg 1)
    CALL seelines(0)
  END
SAY CR
IF bbsprefs.2 & ~terseflag THEN CALL doGrin()

OUT:
SIGNAL OFF BREAK_E
Remote OFF
CALL sound('LOGOFF')
data.18=winnings
line=left(name,16,' ') 'logged off at' time('C')
dcd
IF RC~=0 THEN Send '\ah'
IF data.20~='' THEN
  DO
    Status 'Y'
    elapsed=RESULT
    line=line 'Total:'elapsed
    PARSE VAR elapsed thour':'tmin':'.
    ADDRESS AREXX bbsHOURLY.rexx TIME('H') TIME('M')//60 thour tmin bbspath'Numbers/Hourly'
    PARSE VAR data.19 dhour 'hours' dmin 'minutes in' calls .
    IF ~DATATYPE(tmin,'W')  THEN tmin=0
    IF ~DATATYPE(thour,'W') THEN thour=0
    IF ~DATATYPE(dhour,'W') THEN dhour=0
    IF ~DATATYPE(dmin,'W')  THEN dmin=0
    IF ~DATATYPE(calls,'W') THEN calls=0
    IF thour=0 & tmin<3 THEN  /* free call if less than 3 minutes */
      DO
        wordloc=WORDINDEX(data.11,3)-1
        wordval=WORD(data.11,3)+1
        data.11=DELWORD(data.11,3,1)
        data.11=INSERT(wordval' ',data.11,wordloc)
      END
    ufile=LEFT(DATE('S'),6)
    mmins=thour*60+tmin+countcheck(bbspath'Usage/'ufile 0)
    CALL countcheck(bbspath'Usage/'ufile mmins)
    mins=thour*60+tmin+countcheck(bbspath'Numbers/Minutes' 0)
    CALL countcheck(bbspath'Numbers/Minutes' mins)
    mins=thour*60+tmin+countcheck(bbspath'Numbers/Minutes'bps 0)
    CALL countcheck(bbspath'Numbers/Minutes'bps mins)
    cals=countcheck(bbspath'Numbers/Calls' 0)+1
    CALL countcheck(bbspath'Numbers/Calls' cals)
    cals=countcheck(bbspath'Numbers/Calls'bps 0)+1
    CALL countcheck(bbspath'Numbers/Calls'bps cals)
    thour=thour+dhour
    tmin=tmin+dmin+1
    IF tmin>59 THEN
      DO
        thour=thour+tmin%60
        tmin=tmin//60
      END
    data.19=thour 'hours' tmin 'minutes in' calls+1 'calls.'
    CALL SETCLIP('BBS_totalusage',mmins%60 mmins//60)
    CALL SETCLIP('BBS_userlogoff',TIME('C') DATE())
    CALL postuser(6)
    IF newfilesflag=1 THEN
      DO
        newfilesdate=DATE('S') TIME()
        lastbrowse=countcheck(bbspath'Numbers/LastFile' 0)
      END
    IF clear_marked=1 THEN data.24=''
    CALL saveData(1)
    data.5=''
    IF EXISTS(bbspath'EmailFiles/'name'/QUICKIN.lha') THEN
      DO
        IF sortalphaflag>0 | savefileflag>0 THEN
          CALL SETCLIP('BBS_QUICK_WAIT',1)
        ADDRESS AREXX bbsQUICKIN.rexx name level sysoplevel bbsprefs.6
      END
    arg=''
    lastline=RIGHT(TIME('C'),7) LEFT(DATE(),6)
    lastline=lastline'  'RIGHT(city,40)
    lastline=OVERLAY(name,lastline,16,LENGTH(name)+1) RIGHT(bps,5)
    lastline=lastline' Time:'elapsed
    newpassword=''
    IF data.20=0 THEN lastline=OVERLAY('UNVALIDATED_USER',lastline,16,38)
    CALL send2last(lastline)
    CALL bbsLOGOFF.baud(name level elapsed)
    SAY lastline||def||CR
  END

OUT2:
CALL send2log(line)

DONE:
CALL send2log('')
logonflag=0

DONE2:
CBVflag=0
CALL setdir(libpath||dirs.1)
CALL SETCLIP('BBS_winnings')
CALL SETCLIP('BBS_minutes')
CALL SETCLIP('BBS_level')
CALL SETCLIP('BBS_door')
Capture
IF RC~=0 THEN Capture OFF
Send '\c\ah'
IF WORDS(bbsprefs.27)=8 THEN CALL dimBBcols()
ELSE IF bbsprefs.27=1 THEN CALL ScreenToBack('BAUD')
ELSE IF bbsprefs.27=2 THEN Screen OFF
ELSE CALL DELAY(14)
Remote OFF
baud maxbps
IF sortuserflag=0 & sortalphaflag=0 & savefileflag=0 & emailonline>=0 & buildalpha=0 THEN
  CALL DELAY(128)
ELSE
  DO
    Send 'ATZH1\r'
    CALL DELAY(128)
    Send 'ATH1\r'
  END
IF buildalpha~=0 THEN
  DO
    CALL BuildALPHA.rexx()
    sortalphaflag=0
    savefileflag=0
    buildalpha=0
  END
IF sortuserflag=1 THEN
  DO
    CALL sortuserlist()
    IF SHOW('P','BBBBS_LOCAL') THEN
      DO
        CALL SETCLIP('BBS_localusers')
        CALL SETCLIP('BBS_mainusers',1)
      END
  END
IF sortalphaflag>0 | savefileflag>0 THEN
  DO
    IF savefileflag>0 THEN CALL savefilelist2()
    ELSE CALL savealphalist()
    IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',2)
    CALL SETCLIP('BBS_QUICK_WAIT')
  END
IF emailonline<0 THEN CALL countmail()
bad_atz=ATZreset()   /* reset modem */
IF bbsprefs.15=0 THEN  /* quit or restart? */
  DO
    IF words(bbsprefs.27)=8 THEN CALL setBBcols()
    CALL checkstats()
    EXIT
  END
IF STORAGE()<bbsprefs.15 THEN
  DO
    IF words(bbsprefs.27)=8 THEN CALL setBBcols()
    SAY CR
    SAY '*** Unsafe memory level!'CR
    line='*** Less than' bbsprefs.15 'bytes available, BBBBS has been unloaded.'
    SAY line||CR
    SAY CR
    CALL send2log(line)
    EXIT
  END
CALL CLOSE(f)
CALL CLOSE('log')
CALL zerovars()
DO FOREVER
  IF GETCLIP('BBS_QUIT')='QUIT' THEN
    DO
      CALL SETCLIP('BBS_QUIT')
      CALL SETCLIP('BBS_maint')
      CALL SETCLIP('BBS_localfiles')
      CALL SETCLIP('BBS_localusers')
      Send '\c'
      IF words(bbsprefs.27)=8 THEN CALL setBBcols()
      EXIT
    END
  xstring=GETCLIP('BBS_interpret')
  IF xstring~='' THEN
    DO
      INTERPRET xstring
      CALL SETCLIP('BBS_interpret')
      SIGNAL DONE2
    END
  IF GETCLIP('BBS_localfiles')>1 & GETCLIP('BBS_maint')='' THEN
    DO
      CALL DELAY(150)
      Send 'ATH1\r'
      CALL SETCLIP('BBS_localfiles')
      CALL loadfiles()
      CALL loadalpha()
      SIGNAL DONE2
    END
  IF GETCLIP('BBS_localusers')~='' THEN
    DO
      CALL DELAY(150)
      Send 'ATH1\r'
      CALL SETCLIP('BBS_localusers')
      CALL loaduserlist()
      SIGNAL DONE2
    END
  IF bad_atz=1 THEN bad_atz=ATZreset()
  dcd
  IF RC~=0 THEN Send '\ah'
  wres=''
  Wait 'RING'
  wres=RESULT
  IF wres='RING' THEN
    DO
      Send 'ATA\r'
      Timeout 45  /* wait 45 seconds for connect */
      wres=''
      Wait 'CONNECT,NO CARRIER,RING,+FCON,+FHNG'
      wres=RESULT
      IF wres~='CONNECT' THEN SIGNAL DONE2
      CALL DELAY(114)
      SAY ' 'CR
      CALL DELAY(28)
      SAY ' 'CR
      dcd
      IF RC=0 THEN
        DO
          CALL DELAY(128)
          dcd
          IF RC=0 THEN
            DO
              CALL DELAY(128)
              dcd
              IF RC=0 THEN SIGNAL DONE2
            END
        END
      IF GETCLIP('BBS_maint')='' THEN
        DO
          CALL SETCLIP('BBS_interpret')
          IF words(bbsprefs.27)=8 THEN CALL setBBcols()
          ELSE IF bbsprefs.27=2 THEN Screen ON
          ELSE CALL DELAY(114)
          SAY ''CR    /* reset text defaults */
          SIGNAL LOGON
        END
      Remote ON
      SAY bbsname 'is busy with periodic maintenance.'CR
      SAY 'Please try again in a few minutes.'CR
      Send '\ah'
      SIGNAL DONE2
    END
  ELSE CALL checkstats()
END
EXIT


dimBBcols:
DO i=0 TO 7
  Send '\S'i'-'WORD('000 BA3 039 878 094 828 552 835',i+1)
END
RETURN


setBBcols:
DO i=0 TO 7
  Send '\S'i'-'WORD(bbsprefs.27,i+1)
END
RETURN


ATZreset:
TimeOut 10
Send 'ATZ\r'
Wait 'OK,RING'
IF RESULT~='OK' THEN
  DO
    Send '\d\wATZ\r'
    Wait 'OK'
    IF RESULT~='OK' THEN
      DO
        Send '\w\w+++\w\w\w\wATH\r'
        CALL sound('ATZ_FAIL')
        IF WORDS(bbsprefs.27)=8 THEN CALL setBBcols()
        ELSE IF bbsprefs.27=1 THEN CALL ScreenToFront('BAUD')
        ELSE IF bbsprefs.27=2 THEN Screen ON
        line='*** ATZ failed to reset!' TIME('C') DATE()
        SAY line'  Check your modem!!'CR
        CALL send2log(line)
        RETURN 1
      END
  END
TimeOut 45
Send '\dATH\r'
RETURN 0


getbaudrate: PROCEDURE
TRACE OFF
BaudRate
brate=RC
TRACE
RETURN brate


checkalias:
addressee=''
IF alias.0=0 THEN RETURN 0
DO i=1 TO alias.0
 IF UPPER(alias.i)=UPPER(string) THEN
  DO
   addressee=realname.i
   LEAVE i
  END
END
IF addressee='' THEN RETURN 0
string=''
SAY pen3'Email to 'def||addressee||CR
CALL editor('MAIL' addressee)
RETURN 0


Friends:
ch=''
aliasexclude='sysop bye off'
DO WHILE ch~='Q'
  SAY CR
  SAY pen3||LEFT('=',75,'=')def||CR
  SAY CENTER('F R I E N D S - L I S T',75)||CR
  SAY CR
  SAY CENTER('A L I A S   E D I T O R',75)||CR
  SAY pen3||LEFT('=',75,'=')def||CR
  SAY CR
  SAY '                           'pen3'W - 'def'What is the Friends List? 'CR
  SAY '                           'pen3'A - 'def'Add an Alias 'CR
  SAY '                           'pen3'D - 'def'Delete an Alias 'CR
  SAY '                           'pen3'V - 'def'View my Aliases 'CR
  SAY '                           'pen3'Q - 'def'Return to Main Menu'CR
  SAY CR
  ch=getinput(1 1 pen3'Enter Choice > 'def)
  SELECT
    WHEN ch='W' THEN CALL whatFriends()
    WHEN ch='A' THEN CALL addalias()
    WHEN ch='D' THEN CALL delalias()
    WHEN ch='V' THEN CALL viewalias()
    WHEN ch='Q' THEN CALL saveFriends()
    OTHERWISE SAY 'No such command'CR
  END
END
string=''
RETURN


saveFriends:
frn=bbspath'Friends/'name
IF alias.0<1 THEN
  DO
    CALL DELETE(frn)
    RETURN
  END
CALL OPEN(f,frn,'W')
DO i=1 TO alias.0
  CALL WRITELN(f,alias.i'  'realname.i)
END
CALL CLOSE(f)
RETURN


whatFriends:
CALL readlines(bbspath'Information/BBBBS.Friends' 1)
CALL cleanline(0)
CALL seelines(0)
IF waitchar~='Q' THEN CALL waiting()
nonstop=0
RETURN


addalias:
match=0
username=getinput(1 0 pen3'Enter Users Email Name > 'def)
username=cleanstring(1':'username)
IF username='' THEN RETURN
IF FIND(userlist,username)=0 THEN
 DO
  SAY 'Username not found'CR
  RETURN
 END
newalias=getinput(1 0 pen3'Enter an Alias for'def' 'username def'> ')
IF newalias='' THEN RETURN
IF alias.0>0 THEN
  DO i=1 TO alias.0
   IF UPPER(alias.i)=UPPER(newalias) THEN match=1
  END
IF FIND(aliasexclude,newalias)>0 THEN match=2
IF match=0 THEN
  DO
   alias.0=alias.0+1
   num=alias.0
   alias.num=newalias
   realname.num=username
   SAY alias.num 'alias as ' realname.num 'added'CR
  END
ELSE IF match=1 THEN SAY 'Alias 'newalias' already exists'CR
ELSE SAY newalias ' is a reserved name'CR
RETURN


delalias:
match=0
dalias=getinput(1 0 pen3'Enter Alias to Delete > 'def)
dalias=UPPER(WORD(dalias,1))
IF alias.0>0 THEN
  DO i=1 TO alias.0
   IF UPPER(alias.i)=UPPER(dalias) THEN
    DO
     match=1
     num=i
     LEAVE i
    END
  END
IF match=1 THEN
 DO
  IF getinput(1 1 'Really Delete 'dalias'? (Ny) > ')='Y' THEN
   DO
    DO i=num TO alias.0
     j=i+1
     alias.i=alias.j
     realname.i=realname.j
    END
    alias.0=alias.0-1
   END
 END
ELSE SAY dalias' not Found.'CR
RETURN


viewalias:
IF alias.0>0 THEN
DO i=1 TO alias.0
 SAY RIGHT(alias.i,22) 'is' realname.i||CR
END
ELSE SAY 'No Aliases assigned'CR
RETURN


upCBV:
ARG res .
temp=bbspath'Lists/CBV_USERS'
IF EXISTS(temp) THEN t2='A'
ELSE t2='W'
x=OPEN(f,temp,t2)
IF x=0 THEN RETURN 1
IF t2='W' THEN CALL WRITELN(f,'*** Call Back Verify Log ***')
temp=RIGHT(TIME('C'),7) COMPRESS(DATE())
temp=temp LEFT(name,24) RIGHT(telnum' RESULT:',20) res
CALL WRITELN(f,temp)
CALL CLOSE(f)
RETURN 0


CBV:
IF bbsprefs.22=0 THEN RETURN
SAY CR
CALL showtext(bbspath'BBS_TEXT/CBV_INFO')
SAY CR
telnum=getinput(1 0 pen7'Please Enter Phone Number For Call Back: 'def )
mask=COMPRESS(XRANGE(),'0123456789-, @#*')
telnum=COMPRESS(telnum,mask)
IF telnum='' THEN RETURN
DO n=1 WHILE n<LENGTH(telnum) & ~DATATYPE(SUBSTR(telnum,n,1),'W')
END
IF SUBSTR(telnum,n,1)<2 THEN
  DO
    SAY 'No long distance numbers, please!'CR
    RETURN
  END
temp='The BBS will now call' telnum 'to verify. Correct? (Ny) > '
IF getinput(1 1 temp)~='Y' THEN RETURN
CALL sound('CBV')
telnum=COMPRESS(telnum)
data.27=STRIP(data.27 telnum)
SAY pen3'Logging Off. Callback to' telnum 'in 30 seconds.'def||CR
SAY 'When your modem rings, type  ATA  and press RETURN.'CR
SAY pen2'GoodBye for now,' name '.'def||CR
REMOTE OFF
Timeout 10
Send '\ah'
Wait 'OK,RING'
IF RESULT~='OK' THEN
  DO
    Send '\d'
    CALL DELAY(50)
    DO n=1 TO 10 WHILE ATZreset()=1
    END
  END
CALL DELAY(50)
Send 'ATH1\r'
SAY CR
CALL DELAY(100)
SAY CR
DO n=14 TO 1 BY -1
  MSG '1B'x'M' n*2 'seconds left before CBV callback...'
  CALL DELAY(100)
END
MSG lineup 'Beginning CBV callback...               '
SAY CR
Timeout 10
Send '\ah'
Wait 'OK'
IF RESULT~='OK' THEN
  DO
    Send '\d'
    CALL DELAY(50)
    DO n=1 TO 10 WHILE ATZreset()=1
    END
  END
CALL DELAY(50)
Send 'ATL3M1DT'telnum'\r'  /* M1 = Speaker ON, L3 = volume up */
Timeout 90
Wait 'CONNECT,NO CARRIER,BUSY,ERROR'
IF RESULT~='CONNECT' THEN
  DO
    CALL upCBV('FAILED')
    SIGNAL OUT
  END
REMOTE ON
DO i=20 TO 0 BY -1
  SAY CENTER(copyright.i,75)||CR
END
SAY CENTER(bbsname 'Call Back Identity Verification',74)||CR
SAY CR
CBVflag=1
Timeout maxidle
DO cnt=1 TO 3
  Namentr=getinput(1 0 pen3'    Enter Name: 'def)
  Namentr=cleanstring('1:'Namentr)
  IF Namentr=name THEN LEAVE cnt
END
DO count=1 TO 4
  IF cnt>3 | count>3 THEN
    DO
      SAY 'Incorrect Entry!'||CR
      SAY 'Verification Denied.'||CR
      SAY pen2'Leave a 'pen3'['pen7'C'pen3']omment'pen2'to SysOp,'CR
      SAY pen2'for manual verification.'CR
      SAY CR
      CALL upCBV('DENIED')
      SIGNAL OUT
    END
  pw=getinput(1 0 pen3'Enter Password: 'def)
  IF UPPER(pw)=data.5 THEN
    DO
      CALL upCBV('VERIFIED')
      v=GETCLIP('BBS_COMMAND')'V'
      CALL SETCLIP('BBS_COMMAND',v)
      CBVflag=0
      RETURN
    END
END
RETURN


/* BBBBS.baud */